﻿<!--#include file=a.asp-->
<!--#include file=Gather.asp-->

<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.0//EN" "http://www.wapforum.org/DTD/xhtml-mobile10.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="content-type" content="application/xhtml+xml; charset=UTF-8"/>
<title>用户管理</title>
<LINK href="images/css.css" type=text/css rel=stylesheet>
<title></title>
<script language="javascript" src="Gatherer.js"></script>
<STYLE type=text/css>
BODY {
	BACKGROUND: #003E3E; MARGIN: 3px; FONT: 9pt 宋体;width:950px;border:1px solid grey;padding:5px;margin:0 auto;margin-top:10px;margin-bottom:10px;
	scrollbar-face-color: #DEE3E7;
scrollbar-highlight-color: #FFFFFF;
scrollbar-shadow-color: #DEE3E7;
scrollbar-3dlight-color: #D1D7DC;
scrollbar-arrow-color:  #006699;
scrollbar-track-color: #EFEFEF;
scrollbar-darkshadow-color: #98AAB1;
}
TABLE {
	BORDER-RIGHT: 0px; BORDER-TOP: 0px; BORDER-LEFT: 0px; BORDER-BOTTOM: 0px
}
TD {
	FONT: 12px 宋体
}
IMG {
	BORDER-RIGHT: 0px; BORDER-TOP: 0px; VERTICAL-ALIGN: bottom; BORDER-LEFT: 0px; BORDER-BOTTOM: 0px
}
A {
	FONT: 12px 宋体; COLOR: #E1E100; TEXT-DECORATION: none
}
A:hover {
	COLOR: #D2E9FF
}
.fminpt
{
	BORDER: #111111 1px solid;
	FONT-SIZE: 9pt;
	BACKGROUND-color: #ffffff
}
.TBBG9
{
	BACKGROUND-COLOR: #CE0000;
	BORDER: medium none;
	COLOR: #00000;
	HEIGHT: 22px;
	font-size: 14pt
}
.TBBG91
{
	BACKGROUND-COLOR: #613030;
	BORDER: medium none;
	COLOR: #E1E100;
	HEIGHT: 100px;
	font-size: 22pt
}
.TBBG91 a{font-size:22pt;text-decoration:none;color:#E1E100}
.fmbtn
{
	BACKGROUND-COLOR: #CE0000;
	BORDER: medium none;
	COLOR: #00000;
	HEIGHT: 22px;
	font-size: 14pt
}
.backs
{
	BACKGROUND-COLOR: #CE0000;
	COLOR: #ffffff;

}
</STYLE></head>

<body><br/>
<div align="center" class="TBBG91">欢迎使用晴天3G建站系统<br/><a href='admin_view_gather.asp?sid=<%=sidd%>'>进入文章采集</a>|<a href='admin_file_gather.asp?sid=<%=sidd%>'>进入软件采集</a></div>
<%
Server.ScriptTimeOut = 18000



const PageSize=100	'一页100条记录

IF  Request.QueryString("Action")="add" Then
	call add
elseIF  Request.QueryString("Action")="edit" Then
	call edit
elseIF  Request.QueryString("Action")="del" Then
	call del
elseIF  Request.QueryString("Action")="yanshi" Then
	call yanshi
elseIF  Request.QueryString("Action")="Begin" Then
	call savenew
elseIF  Request.QueryString("Action")="ghost" Then
	call ghost
elseIF  Request.QueryString("Action")="savenew" Then
	call DataCollection
else
	call main
end if




Function ghost


	If Request("SubmitFlag") = "" Then
%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=ghost&itemid=<%=Request("itemid")%>" >
<%else%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=add">
<%end if%>
  <p style="margin-left:15px;">
  <b>克隆采集项目</b>
  <br/><a href='admin_bbs_Gather.asp'>返回论坛帖子采集</a></p>
  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">

	<tr>
	<td align="center">
	<%
	If Request("SubmitFlag") <> "" Then
			ghost2
	Else
			ghost1
	End If
	%>

</table>
</form>
<%

End Function



Function ghost1

dim itemid
itemid=TRim(Request("itemid"))
if not isnumeric(itemid) then itemid=""



			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then


%>
  <input type="hidden" name="SubmitFlag" value="stp2">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		
  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">项目名称:</td>
    <td><input name="name" type="text" value="<%=rs("name")%>" class=fminpt size="50" maxlength="50">
    </td>
  </tr>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">目标站点URL:</td>
    <td><input name="url" type="text"  value="<%=rs("url")%>" class=fminpt size="50" maxlength="255">
    </td>
  </tr>
   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">所属分类:</td>
    <td>
	<%set rs1=server.CreateObject("adodb.recordset")
	  sql1="SELECT * from qingtian_bbs where del=0 order by pid asc"
	  rs1.open sql1,conn,1,1
	  if not (rs1.bof and rs1.eof) then
	  For i=1 to rs1.RecordCount
		if i=1 then
		%><%if cint(classid)=rs1("id") then%><select name="classid" value="<%=classid%>"><%else%><select name="classid" value="<%=rs1("id")%>"><%end if%><option value=<%=rs1("id")%><%if rs("classid")=rs1("id") then%> selected  <%end if%>><%=rs1("name")%></option><%
		else
		%><option value=<%=rs1("id")%><%if rs("classid")=rs1("id") then%> selected  <%end if%>><%=rs1("name")%></option><%
		end if
	  Rs1.MoveNext
	  Next

	  end if
	  Rs1.close
	  set rs1=nothing
	%>
    </select>
    </td>
  </tr>


  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">远程列表URL：</td>
    <td><input name="RemoteListUrl"   value="<%=rs("Remotelisturl")%>" type="text" class=fminpt size="50" maxlength="255">
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否列表分页采集：</td>
    <td>
	<input name="IsPagination" type="radio" value="0" <%if rs("IsPagination")=0 then%>checked<%end if%> onClick="Pageinate1.style.display='none';Pageinate2.style.display='none';"> 否&nbsp;&nbsp;
      	<input type="radio" name="IsPagination" value="1" <%if rs("IsPagination")=1 then%>checked<%end if%> onClick="Pageinate1.style.display='';Pageinate2.style.display='';"> 是
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="Pageinate1" style="display:'none';"> 
    <td class="tar" width="25%">远程列表分页URL：</td>
    <td>
	<input name="PaginalList"  value="<%=rs("PaginalList")%>"  type="text" id="PaginalList" class=fminpt  size="50">
      	* 分页代码 <font color="red">{$pageid}</font>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="Pageinate2" style="display:'none';"> 
    <td class="tar" width="25%">远程列表起始页：</td>
    <td>
	开始页：<input name="startid" type="text"  value="<%=rs("startid")%>"  class=fminpt size="10" maxlength="255">&nbsp;-
   	结束页：<input name="lastid" type="text"  value="<%=rs("lastid")%>"  class=fminpt size="10" maxlength="255">&nbsp;
    	* 例如：1 - 9 或者 9 - 1
    </td>
  </tr>


  <tr bgcolor=#f7f7f7 class=TBBG9 > 
    <td class="tar" width="25%">指定演示URL：</td>
    <td>
	<input type="text" name=NamedDemourl size=80 value='<%=rs("NamedDemourl")%>'>
    </td>
  </tr>




 </table>

	<tr>
	<td bgcolor=#E8F1FF  align="center">
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回上一页">&nbsp;&nbsp; 
	<input type=submit name="B11" value="开始克隆">　
	</td>
	</tr>
	</td></tr>


		<%
			end if
			rs.Close
			Set rs = Nothing


End Function



Function ghost2

dim itemid
itemid=TRim(Request("itemid"))
if not isnumeric(itemid) then itemid=""

	name=Request.Form("name")
	url=Request.Form("url")
	classid=Request.Form("classid")
	RemoteListUrl=Request.Form("RemoteListUrl")
	IsPagination=Request.Form("IsPagination")
	PaginalList=Request.Form("PaginalList")
	startid=Request.Form("startid")
	lastid=Request.Form("lastid")
	NamedDemourl=Request.Form("NamedDemourl")


			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,1
			if not (rs.bof and rs.eof) then

				Encoding=rs("Encoding")
				AllHits=rs("AllHits")
				RemoveCode=rs("RemoveCode")
				lastime=rs("lastime")
				FindListCode=rs("FindListCode")
				FindInfoCode=rs("FindInfoCode")
				RetuneClass=rs("RetuneClass")
				IsNextPage=rs("IsNextPage")
				strReplace=rs("strReplace")
				ImgDown=rs("ImgDown")
			end if
			rs.Close
			Set rs = Nothing



			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item "
			rs.open sql,conn2,1,3
			rs.addnew

				rs("name")=name
				rs("url")=url
				rs("classid")=classid
				rs("RemoteListUrl")=RemoteListUrl
				rs("IsPagination")=IsPagination
				rs("PaginalList")=PaginalList
				rs("startid")=startid
				rs("lastid")=lastid
				rs("NamedDemourl")=NamedDemourl



				rs("Encoding")=Encoding
				rs("AllHits")=AllHits
				rs("RemoveCode")=RemoveCode
				rs("lastime")=lastime
				rs("FindListCode")=FindListCode
				rs("FindInfoCode")=FindInfoCode
				rs("RetuneClass")=RetuneClass
				rs("IsNextPage")=IsNextPage
				rs("strReplace")=strReplace
				rs("ImgDown")=ImgDown


			rs.update
			rs.Close
			Set rs = Nothing

				response.Write "<meta http-equiv='refresh' content='1;URL=admin_bbs_Gather.asp'>"
%>


  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">

	<tr>
	<td align="center">

	<tr>
	<td bgcolor=#E8F1FF  align="center">
	克隆采集项目成功!
	</td>
	</tr>
	</td></tr>
</table>
<%




End Function


Function add
if Request("SubmitFlag") = "" then
%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=add"  onSubmit='return CheckForm();'>
<%else%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=add">
<%end if%>
  <p style="margin-left:15px;">
  <b>添加论坛帖子采集项目&nbsp;&nbsp;-&nbsp;&nbsp;<%if Request("SubmitFlag") = "stp2" then%>设置第二步<%elseif Request("SubmitFlag") = "stp3" then%>设置第三步<%elseif Request("SubmitFlag") = "stp4" then%>设置第四步<%else%>设置第一步<%end if%></b>
  <br/><a href='admin_bbs_Gather.asp'>返回论坛帖子采集</a></p>
  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">

	<tr>
	<td align="center">
	<%
	If Request("SubmitFlag") = "stp2" Then
			stp2
	ElseIf Request("SubmitFlag") = "stp3" Then
			stp3
	ElseIf Request("SubmitFlag") = "stp4" Then
			stp4
			exit Function
	Else
			stp1
	End If
	%>
	<tr>
	<td bgcolor=#E8F1FF  align="center">
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回上一页">&nbsp;&nbsp; 
	<input type=submit name="B11" value=" 下一步 ">　
	<input name="ShowCode" type="checkbox" value="1"> 显示源码
	</td>
	</tr>
	</td></tr>
</table>
</form>
<%

End Function



Function stp1




%>
  <input type="hidden" name="SubmitFlag" value="stp2">
		
  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">项目名称:</td>
    <td><input name="name" type="text" class=fminpt size="50" maxlength="50">
    </td>
  </tr>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">目标站点URL:</td>
    <td><input name="url" type="text" class=fminpt size="50" maxlength="255">
    </td>
  </tr>
   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">所属分类:</td>
    <td>
	<%set rs=server.CreateObject("adodb.recordset")
	  sql="SELECT * from qingtian_bbs where del=0 order by pid asc"
	  rs.open sql,conn,1,1
	  if not (rs.bof and rs.eof) then
	  For i=1 to rs.RecordCount
		if i=1 then
		%><%if cint(classid)=rs("id") then%><select name="classid" value="<%=classid%>"><%else%><select name="classid" value="<%=rs("id")%>"><%end if%><option value=<%=rs("id")%><%if cint(classid)=rs("id") then%> selected  <%end if%>><%=rs("name")%></option><%
		else
		%><option value=<%=rs("id")%><%if cint(classid)=rs("id") then%> selected  <%end if%>><%=rs("name")%></option><%
		end if
	  Rs.MoveNext
	  Next

	  end if
	  Rs.close
	  set rs=nothing
	%>
    </select>
    </td>
  </tr>


   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">目标文档编码：</td>
    <td><select name="Encoding" value="GB2312">
	<option value="GB2312">GB2312</option>

	<option value="UTF-8">UTF-8</option>

	<option value="BIG5">BIG5</option>

    </select>
    </td>
  </tr>


   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">是否下载图片到本地：</td>
    <td>
	<input name="ImgDown" type="radio" value="0" checked> 否&nbsp;&nbsp;
      	<input type="radio" name="ImgDown" value="1"> 是 
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否显示为最新时间：</td>
    <td>
	<input name="IsNowTime" type="radio" value="0" checked> 否&nbsp;&nbsp;
        <input type="radio" name="IsNowTime" value="1"> 是</td>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">初始点击数：</td>
    <td>
	<input name="AllHits" type="text" id="AllHits" size="10" value="0">
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">内容过滤设置：</td>
    <td>
      <input name="RemoveCode0" type="checkbox" value="1" checked> SCRIPT 
      <input name="RemoveCode1" type="checkbox" value="1" checked> IFARME 
      <input name="RemoveCode2" type="checkbox" value="1"> OBJECT 
      <input name="RemoveCode3" type="checkbox" value="1"> APPLET 
      <input name="RemoveCode4" type="checkbox" value="1"> DIV <br>
      <input name="RemoveCode5" type="checkbox" value="1"> FONT 
      <input name="RemoveCode6" type="checkbox" value="1"> SPAN 
      <input name="RemoveCode7" type="checkbox" value="1"> A 
      <input name="RemoveCode8" type="checkbox" value="1"> IMG 
      <input name="RemoveCode9" type="checkbox" value="1"> FORM 
      <input name="RemoveCode10" type="checkbox" value="1"> HTML 
    </td>
  </tr>


  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">远程列表URL：</td>
    <td><input name="RemoteListUrl" type="text" class=fminpt size="50" maxlength="255">
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否列表分页采集：</td>
    <td>
	<input name="IsPagination" type="radio" value="0" checked onClick="Pageinate1.style.display='none';Pageinate2.style.display='none';"> 否&nbsp;&nbsp;
      	<input type="radio" name="IsPagination" value="1" onClick="Pageinate1.style.display='';Pageinate2.style.display='';"> 是
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="Pageinate1" style="display:'none';"> 
    <td class="tar" width="25%">远程列表分页URL：</td>
    <td>
	<input name="PaginalList" type="text" id="PaginalList" class=fminpt  size="50">
      	* 分页代码 <font color="red">{$pageid}</font>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="Pageinate2" style="display:'none';"> 
    <td class="tar" width="25%">远程列表起始页：</td>
    <td>
	开始页：<input name="startid" type="text" class=fminpt size="10" maxlength="255">&nbsp;-
   	结束页：<input name="lastid" type="text" class=fminpt size="10" maxlength="255">&nbsp;
    	* 例如：1 - 9 或者 9 - 1
    </td>
  </tr>





   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">内容字符替换操作：</td>
    <td>

<table border="0" cellpadding="3"><tr><td>
      <select name="strReplace" id="strReplace" style="width:380;height:100" size="2" ondblclick="return ModifyReplace();">
        
      </select></td><td>
      <input type="button" name="addreplace" value="添加替换字符" class="button" onClick="AddReplace();"><br><br style="overflow: hidden; line-height: 5px">
      <input type="button" name="modifyreplace" value="修改当前字符" class="button" onClick="return ModifyReplace();"><br><br style="overflow: hidden; line-height: 5px">
      <input type="button" name="delreplace" value="删除当前字符" class="button" onClick="DelReplace();"><br>
      <input type="hidden" name="ReplaceList" value="">
        </td><tr></table>
    </td>
  </tr>







 </table>
		<%

End Function




Function stp2
	dim flag,errmsg,name,title,url,user
	flag=1

	showcode=Request.Form("showcode")

	name=Request.Form("name")
	url=Request.Form("url")
	classid=Request.Form("classid")
	Encoding=Request.Form("Encoding")
	ImgDown=Request.Form("ImgDown")

	IsNowTime=Request.Form("IsNowTime")
	AllHits=Request.Form("AllHits")
	RemoveCode0=Request.Form("RemoveCode0")
	RemoveCode1=Request.Form("RemoveCode1")
	RemoveCode2=Request.Form("RemoveCode2")
	RemoveCode3=Request.Form("RemoveCode3")
	RemoveCode4=Request.Form("RemoveCode4")
	RemoveCode5=Request.Form("RemoveCode5")
	RemoveCode6=Request.Form("RemoveCode6")
	RemoveCode7=Request.Form("RemoveCode7")
	RemoveCode8=Request.Form("RemoveCode8")
	RemoveCode9=Request.Form("RemoveCode9")
	RemoveCode10=Request.Form("RemoveCode10")
	RemoteListUrl=Request.Form("RemoteListUrl")
	IsPagination=Request.Form("IsPagination")
	PaginalList=Request.Form("PaginalList")
	startid=Request.Form("startid")
	lastid=Request.Form("lastid")
	ReplaceList=Request.Form("ReplaceList")

	if Encoding="" then Encoding="GB2312"
	if ImgDown="" then ImgDown=0
	if IsNowTime="" then IsNowTime=0
	if AllHits="" then AllHits=0

	if IsPagination="" then IsPagination=0
	if startid="" then startid=0
	if lastid="" then lastid=0
	if RemoveCode0="" then RemoveCode0=0
	if RemoveCode1="" then RemoveCode1=0
	if RemoveCode2="" then RemoveCode2=0
	if RemoveCode3="" then RemoveCode3=0
	if RemoveCode4="" then RemoveCode4=0
	if RemoveCode5="" then RemoveCode5=0
	if RemoveCode6="" then RemoveCode6=0
	if RemoveCode7="" then RemoveCode7=0
	if RemoveCode8="" then RemoveCode8=0
	if RemoveCode9="" then RemoveCode9=0
	if RemoveCode10="" then RemoveCode10=0

	RemoveCode=RemoveCode0 & "|" & RemoveCode1 & "|" & RemoveCode2 & "|" & RemoveCode3 & "|" & RemoveCode4 & "|" & RemoveCode5 & "|" & RemoveCode6 & "|" & RemoveCode7 & "|" & RemoveCode8 & "|" & RemoveCode9 & "|" & RemoveCode10

	if name=""  then errmsg=errmsg&"项目名称不能为空\n":flag=0
	if classid=""  then errmsg=errmsg&"所属分类不能为空\n":flag=0
	if not isnumeric(classid) then errmsg=errmsg&"分类必须为数字\n":flag=0
	if url=""  then errmsg=errmsg&"目标站点URL不能为空\n":flag=0
	if RemoteListUrl=""  then errmsg=errmsg&"远程列表URL不能为空\n":flag=0



if flag<>0 then





			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item"
			rs.open sql,conn2,1,3
			rs.addnew()
			rs("name")=name
			rs("url")=url
			rs("classid")=classid
			rs("Encoding")=Encoding
			rs("ImgDown")=ImgDown

			rs("IsNowTime")=IsNowTime
			rs("RemoveCode")=RemoveCode
			rs("RemoteListUrl")=RemoteListUrl
			rs("IsPagination")=IsPagination
			rs("startid")=startid
			rs("lastid")=lastid
			rs("strReplace")=ReplaceList
			rs("PaginalList")=PaginalList
			rs.update()
			itemid=rs("id")
			rs.Close
			Set rs = Nothing














%>
  <input type="hidden" name="SubmitFlag" value="stp3">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>

<%
	if showcode=1 then
		HTTPHtmlCode=GetRemoteData(Trim(RemoteListUrl), Trim(Encoding))
		If HTTPHtmlCode = "" Then
			Response.Write "<script language=javascript>" & vbCrLf
			Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
			Response.Write "history.go(-1);" & vbCrLf
			Response.Write "</script>" & vbCrLf
		End If%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><textarea name='content' id='content' wrap='OFF' style='width:100%;' rows='20'><%=Server.HTMLEncode(HTTPHtmlCode)%></textarea><div align='right'><a href="javascript:admin_Size(-20,'content')"><img src='images/minus.gif' unselectable=on border=0></a> <a href="javascript:admin_Size(20,'content')"><img src='images/plus.gif' unselectable=on border=0></div></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2">采集的目标地址 → <a href='<%=RemoteListUrl%>' target='_blank'><font color='red'><%=RemoteListUrl%></font></a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='view-source:<%=RemoteListUrl%>' target='_blank'><font color='blue'>点击查看目标源代码</font></a></td> 
  </tr> 

<%
	end if


%>


  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取列表开始代码:</td>
    <td>
	<textarea name=FindListCode0 rows=5 cols=80>0</textarea>
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取列表结束代码:</td>
    <td>
	<textarea name=FindListCode1 rows=5 cols=80>0</textarea>
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取连接开始代码:</td>
    <td>
	<textarea name=FindListCode2 rows=5 cols=80>0</textarea></td> 
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取连接结束代码:</td>
    <td>
	<textarea name=FindListCode3 rows=5 cols=80>0</textarea>
    </td>
  </tr>




 </table>
		<%















	else
	Response.Write "<script language=javascript>" & vbCrLf
	Response.Write "alert('"&errmsg&"');"
	Response.Write "history.go(-1);" & vbCrLf
	Response.Write "</script>" & vbCrLf
		
	end if	
End Function




Function stp3
	dim flag,errmsg,name,title,url,user
	flag=1

	itemid=Request.Form("itemid")
	showcode=Request.Form("showcode")


	FindListCode0=Request.Form("FindListCode0")
	FindListCode1=Request.Form("FindListCode1")
	FindListCode2=Request.Form("FindListCode2")
	FindListCode3=Request.Form("FindListCode3")


	if FindListCode0="" then FindListCode0=0
	if FindListCode1="" then FindListCode1=0
	if FindListCode2="" then FindListCode2=0
	if FindListCode3="" then FindListCode3=0


	FindListCode=FindListCode0 & "$$$" & FindListCode1 & "$$$" & FindListCode2 & "$$$" & FindListCode3


	strFindListCode = Split(ReplaceTrim(FindListCode), "$$$")

			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs("FindListCode")=FindListCode
			RemoteListUrl=rs("RemoteListUrl")
			Encoding=rs("Encoding")
			rs.update()
			end if
			rs.Close
			Set rs = Nothing
















%>
  <input type="hidden" name="SubmitFlag" value="stp4">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>


<%
	if showcode=1 then
		HTTPHtmlCode=ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Trim(Encoding)))
		If HTTPHtmlCode = "" Then
			Response.Write "<script language=javascript>" & vbCrLf
			Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
			Response.Write "history.go(-1);" & vbCrLf
			Response.Write "</script>" & vbCrLf
		End If


				'--获取远程列表代码
				strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
				strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
				If strRemoteLisCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程列表出错！请确定你的远程列表开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				'--获取列表URL
				strRemoteListUrl = CutFixed(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
				strRemoteListUrl = FormatRemoteUrl(RemoteListUrl, strRemoteListUrl)
				If strRemoteListUrl = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程连接出错！请确定你的连接开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				HTTPHtmlCode = GetRemoteData(strRemoteListUrl, Encoding)
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><textarea name='content' id='content' wrap='OFF' style='width:100%;' rows='20'><%=Server.HTMLEncode(HTTPHtmlCode)%></textarea><div align='right'><a href="javascript:admin_Size(-20,'content')"><img src='images/minus.gif' unselectable=on border=0></a> <a href="javascript:admin_Size(20,'content')"><img src='images/plus.gif' unselectable=on border=0></div></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2">采集的目标地址 → <a href='<%=strRemoteListUrl%>' target='_blank'><font color='red'><%=strRemoteListUrl%></font></a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='view-source:<%=strRemoteListUrl%>' target='_blank'><font color='blue'>点击查看目标源代码</font></a></td> 
  </tr> 

<%
	end if
%>


  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子标题开始代码:</td>
    <td>
	<textarea name=FindInfoCode0 rows=5 cols=80>0</textarea>
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子标题结束代码:</td>
    <td>
	<textarea name=FindInfoCode1 rows=5 cols=80>0</textarea>
    </td>
  </tr>


  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子内容开始代码:</td>
    <td>
	<textarea name=FindInfoCode2 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子内容结束代码:</td>
    <td>
	<textarea name=FindInfoCode3 rows=5 cols=80>0</textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">论坛帖子作者设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont1" onClick="InfoCode1.style.display='none';InfoCode2.style.display='none';" checked> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont1" onClick="InfoCode1.style.display='';InfoCode2.style.display='';">打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果指定作者,开始代码填“0”，结束代码填作者名称</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode1"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子作者开始代码：</td>
    <td>
	<textarea name=FindInfoCode4 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode2"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子作者结束代码：</td>
    <td>
	<textarea name=FindInfoCode5 rows=5 cols=80>0</textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">论坛帖子来源设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont2" onClick="InfoCode3.style.display='none';InfoCode4.style.display='none';" checked> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont2" onClick="InfoCode3.style.display='';InfoCode4.style.display='';">打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果要指定来源,开始代码填“0”，结束代码填来源</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode3"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子来源开始代码：</td>
    <td>
	<textarea name=FindInfoCode6 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode4"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子来源结束代码：</td>
    <td>
	<textarea name=FindInfoCode7 rows=5 cols=80>0</textarea>
    </td>
  </tr>





  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">论坛帖子更新时间设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont3" onClick="InfoCode5.style.display='none';InfoCode6.style.display='none';" checked> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont3" onClick="InfoCode5.style.display='';InfoCode6.style.display='';">打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果第一步设置显示为最新时间，此设置无效</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode5"  style="display:'none';"> 
    <td class="tar" width="25%">获取更新时间开始代码：</td>
    <td>
	<textarea name=FindInfoCode8 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode6"  style="display:'none';"> 
    <td class="tar" width="25%">获取更新时间结束代码：</td>
    <td>
	<textarea name=FindInfoCode9 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否内容分页采集：</td>
    <td>
	<Input type="radio" value="0" name="selfont4" onClick="InfoCode7.style.display='none';InfoCode8.style.display='none';InfoCode9.style.display='none';InfoCode10.style.display='none';" checked> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont4" onClick="InfoCode7.style.display='';InfoCode8.style.display='';InfoCode9.style.display='';InfoCode10.style.display='';">打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果内容有分页，请设置此项</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode7"  style="display:'none';"> 
    <td class="tar" width="25%">内容分页列表开始代码：</td>
    <td>
	<textarea name=FindInfoCode10 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode8"  style="display:'none';"> 
    <td class="tar" width="25%">内容分页列表结束代码：</td>
    <td>
	<textarea name=FindInfoCode11 rows=5 cols=80>0</textarea>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode9"  style="display:'none';"> 
    <td class="tar" width="25%">获取分页连接开始代码：</td>
    <td>
	<textarea name=FindInfoCode12 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode10"  style="display:'none';"> 
    <td class="tar" width="25%">获取分页连接结束代码：</td>
    <td>
	<textarea name=FindInfoCode13 rows=5 cols=80>0</textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">内容过滤设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont5" onClick="InfoCode11.style.display='none';InfoCode12.style.display='none';InfoCode13.style.display='none';InfoCode14.style.display='none';" checked> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont5" onClick="InfoCode11.style.display='';InfoCode12.style.display='';InfoCode13.style.display='';InfoCode14.style.display='';">打开设置窗口&nbsp;&nbsp;
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode11"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符一：</td>
    <td>
	<textarea name=FindInfoCode14 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode12"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符二：</td>
    <td>
	<textarea name=FindInfoCode15 rows=5 cols=80>0</textarea>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode13"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符三：</td>
    <td>
	<textarea name=FindInfoCode16 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode14"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符四：</td>
    <td>
	<textarea name=FindInfoCode17 rows=5 cols=80>0</textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">匹配字符设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont6" onClick="InfoCode15.style.display='none';InfoCode16.style.display='none';InfoCode17.style.display='none';InfoCode18.style.display='none';" checked> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont6" onClick="InfoCode15.style.display='';InfoCode16.style.display='';InfoCode17.style.display='';InfoCode18.style.display='';">打开设置窗口&nbsp;&nbsp;
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode15"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤一开始代码：</td>
    <td>
	<textarea name=FindInfoCode18 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode16"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤一结束代码：</td>
    <td>
	<textarea name=FindInfoCode19 rows=5 cols=80>0</textarea>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode17"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤二开始代码：</td>
    <td>
	<textarea name=FindInfoCode20 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode18"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤二结束代码：</td>
    <td>
	<textarea name=FindInfoCode21 rows=5 cols=80>0</textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9 > 
    <td class="tar" width="25%">指定演示URL：</td>
    <td>
	<input type="text" name=NamedDemourl size=80 value=''>
    </td>
  </tr>



 </table>
		<%








End Function





Function stp4
	dim flag,errmsg,name,title,url,user
	flag=1

	itemid=Request.Form("itemid")
	showcode=Request.Form("showcode")
	NamedDemourl=Request.Form("NamedDemourl")
	FindInfoCode0=Request.Form("FindInfoCode0")
	FindInfoCode1=Request.Form("FindInfoCode1")
	FindInfoCode2=Request.Form("FindInfoCode2")
	FindInfoCode3=Request.Form("FindInfoCode3")
	FindInfoCode4=Request.Form("FindInfoCode4")
	FindInfoCode5=Request.Form("FindInfoCode5")
	FindInfoCode6=Request.Form("FindInfoCode6")
	FindInfoCode7=Request.Form("FindInfoCode7")
	FindInfoCode8=Request.Form("FindInfoCode8")
	FindInfoCode9=Request.Form("FindInfoCode9")
	FindInfoCode10=Request.Form("FindInfoCode10")
	FindInfoCode11=Request.Form("FindInfoCode11")
	FindInfoCode12=Request.Form("FindInfoCode12")
	FindInfoCode13=Request.Form("FindInfoCode13")
	FindInfoCode14=Request.Form("FindInfoCode14")
	FindInfoCode15=Request.Form("FindInfoCode15")
	FindInfoCode16=Request.Form("FindInfoCode16")
	FindInfoCode17=Request.Form("FindInfoCode17")
	FindInfoCode18=Request.Form("FindInfoCode18")
	FindInfoCode19=Request.Form("FindInfoCode19")
	FindInfoCode20=Request.Form("FindInfoCode20")
	FindInfoCode21=Request.Form("FindInfoCode21")
	FindInfoCode22=Request.Form("FindInfoCode22")
	IsNextPage=Request.Form("selfont4")


	if FindInfoCode0="" then FindInfoCode0=0
	if FindInfoCode1="" then FindInfoCode1=0
	if FindInfoCode2="" then FindInfoCode2=0
	if FindInfoCode3="" then FindInfoCode3=0
	if FindInfoCode4="" then FindInfoCode4=0
	if FindInfoCode5="" then FindInfoCode5=0
	if FindInfoCode6="" then FindInfoCode6=0
	if FindInfoCode7="" then FindInfoCode7=0
	if FindInfoCode8="" then FindInfoCode8=0
	if FindInfoCode9="" then FindInfoCode9=0
	if FindInfoCode10="" then FindInfoCode10=0
	if FindInfoCode11="" then FindInfoCode11=0
	if FindInfoCode12="" then FindInfoCode12=0
	if FindInfoCode13="" then FindInfoCode13=0
	if FindInfoCode14="" then FindInfoCode14=0
	if FindInfoCode15="" then FindInfoCode15=0
	if FindInfoCode16="" then FindInfoCode16=0
	if FindInfoCode17="" then FindInfoCode17=0
	if FindInfoCode18="" then FindInfoCode18=0
	if FindInfoCode19="" then FindInfoCode19=0
	if FindInfoCode20="" then FindInfoCode20=0
	if FindInfoCode21="" then FindInfoCode21=0
	if FindInfoCode22="" then FindInfoCode22=0



	FindInfoCode=FindInfoCode0 & "$$$" & FindInfoCode1 & "$$$" & FindInfoCode2 & "$$$" & FindInfoCode3 & "$$$" & FindInfoCode4 & "$$$" & FindInfoCode5 & "$$$" & FindInfoCode6 & "$$$" & FindInfoCode7 & "$$$" & FindInfoCode8 & "$$$" & FindInfoCode9 & "$$$" & FindInfoCode10 & "$$$" & FindInfoCode11 & "$$$" & FindInfoCode12 & "$$$" & FindInfoCode13 & "$$$" & FindInfoCode14 & "$$$" & FindInfoCode15 & "$$$" & FindInfoCode16 & "$$$" & FindInfoCode17 & "$$$" & FindInfoCode18 & "$$$" & FindInfoCode19 & "$$$" & FindInfoCode20 & "$$$" & FindInfoCode21 & "$$$" & FindInfoCode22




			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs("FindInfoCode")=FindInfoCode
			rs("NamedDemourl")=NamedDemourl
			RemoteListUrl=rs("RemoteListUrl")
			Encoding=rs("Encoding")
			RemoveCode=rs("RemoveCode")
			strFindListCode = Split(ReplaceTrim(rs("FindListCode")), "$$$")
			rs("IsNextPage")=IsNextPage
			rs.update()
			end if
			rs.Close
			Set rs = Nothing






	strFindInfoCode = Split(ReplaceTrim(FindInfoCode), "$$$")


















%>
  <input type="hidden" name="SubmitFlag" value="stp3">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
 

<%
	if showcode=1 then
		if NamedDemourl ="" then
			HTTPHtmlCode=ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Trim(Encoding)))
			If HTTPHtmlCode = "" Then
				Response.Write "<script language=javascript>" & vbCrLf
				Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
				Response.Write "history.go(-1);" & vbCrLf
				Response.Write "</script>" & vbCrLf
			End If


				'--获取远程列表代码
				strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
				strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
				If strRemoteLisCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程列表出错！请确定你的远程列表开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				'--获取列表URL
				strRemoteListUrl = CutFixed(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
				strRemoteListUrl = FormatRemoteUrl(RemoteListUrl, strRemoteListUrl)
				If strRemoteListUrl = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程连接出错！请确定你的连接开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				HTTPHtmlCode = GetRemoteData(strRemoteListUrl, Encoding)
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If

		else
			strRemoteListUrl=NamedDemourl
		end if

				HTTPHtmlCode = ReplaceTrim(GetRemoteData(strRemoteListUrl, Encoding))
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				
				'--获取论坛帖子标题
				strNewsTitle = CutFixed(HTTPHtmlCode, strFindInfoCode(0), strFindInfoCode(1))
				strNewsTitle = Trim(CheckHTML(strNewsTitle))
				If Len(strNewsTitle) = 0 Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取标题代码出错！请确定你的代码输入正确。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				


				'--获取论坛帖子内容
				NewsContent = CutFixed(HTTPHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
				If Len(NewsContent) = 0 Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取论坛帖子内容代码出错！请确定你的代码输入正确。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If


				
				'--获取论坛帖子作者
				If strFindInfoCode(4) <> "" And strFindInfoCode(4) <> "0" Then
					startcode = Replace(Replace(Replace(strFindInfoCode(4), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
					lastcode = Replace(Replace(Replace(strFindInfoCode(5), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
					strAuthor = CutFixed(HTTPHtmlCode, startcode, lastcode)
					strAuthor = CheckHTML(Trim(strAuthor))
				Else
					If strFindInfoCode(5) <> "" And strFindInfoCode(5) <> "0" Then
						strAuthor = Trim(strFindInfoCode(5))
					Else
						strAuthor = "佚名"
					End If
				End If
				

				'--获取论坛帖子来源
				If strFindInfoCode(6) <> "" And strFindInfoCode(6) <> "0" Then
					startcode = Replace(Replace(Replace(Replace(strFindInfoCode(6), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
					lastcode = Replace(Replace(Replace(Replace(strFindInfoCode(7), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
					strComeFrom = CutFixed(HTTPHtmlCode, startcode, lastcode)
					strComeFrom = CheckHTML(Trim(strComeFrom))
				Else
					If strFindInfoCode(7) <> "" And strFindInfoCode(7) <> "0" Then
						strComeFrom = Trim(strFindInfoCode(7))
					Else
						strComeFrom = "本站整理"
					End If
				End If
				
				'--获取论坛帖子更新时间
				If strFindInfoCode(8) <> "" And strFindInfoCode(8) <> "0" Then
					startcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(8), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
					lastcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(9), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
					datNewsTime = CutFixed(HTTPHtmlCode, startcode, lastcode)
					datNewsTime = CheckHTML(datNewsTime)
					datNewsTime = CheckNostr(datNewsTime)
					datNewsTime = Formatime(Trim(datNewsTime))
				Else
					datNewsTime = Now
				End If



		'--------------获取分页内容部分开始-----------------
				Dim n, strTempArray
				If CInt(IsNextPage) > 0 And strFindInfoCode(10) <> "" And strFindInfoCode(10) <> "0" And strFindInfoCode(11) <> "" And strFindInfoCode(11) <> "0" Then
					'-- 分页方法
					
					If strFindInfoCode(12) <> "" And strFindInfoCode(12) <> "0" And strFindInfoCode(13) <> "" And strFindInfoCode(13) <> "0" Then
						'--从内容中读取分页获取列表
						strAddedCode = CutFixate(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
						strAddedCode = ReplaceTrim(strAddedCode)
						If Len(strAddedCode) = 0 Then
							'--从整个HTML代码中获取列表
							strAddedCode = CutFixate(HTTPHtmlCode, strFindInfoCode(10), strFindInfoCode(11))
							strAddedCode = ReplaceTrim(strAddedCode)
						End If
						
						strAddedCode = ReplaceTrim(strAddedCode)
						'--如果可以获取分页列表,开始获取分页URL
						If Len(strAddedCode) > 0 Then
							strAddedlist = FindMatch(strAddedCode, strFindInfoCode(12), strFindInfoCode(13))
							'--判断是否获取到URL
							If Len(strAddedlist) > 0 Then
								strTempContent = ""
								'--把所有URL分割成数组
								AddedlistArray = Split(strAddedlist, "|||")
								For i = 0 To UBound(AddedlistArray)
									'--格式化URL成绝对路径
									PaginationUrl = FormatRemoteUrl(strRemoteListUrl, AddedlistArray(i))
									'--只有URL和当前URL不一样的时候才采集分页信息
									If Len(PaginationUrl) > 8 And LCase(PaginationUrl) <> LCase(strRemoteListUrl) Then
										TempHtmlCode = ReplaceTrim(GetRemoteData(PaginationUrl, strEncoding))
										If Len(TempHtmlCode) > 10 Then
											TempContent = CutFixed(TempHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
											If Len(TempContent) > 0 Then
												'--将获取到分页内容写入到一个临时变量
												strTempContent = strTempContent & "[page_break]" & TempContent
											End If
										End If
									End If
								Next
								NewsContent = NewsContent & strTempContent
								NewsContent = CheckMatch(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
								NewsContent = Replace(NewsContent, "[page_break]", "<br /><span style=""color:red;font-size:12px;font-family:tahoma;font-weight:bold;""><font color='red'>此处是内容分页标签：[page_break]</font></span><br />")
							End If
						End If
					End If
				End If


				'--内容过滤
				TextContent = Html2Ubb(NewsContent, RemoveCode)
				If strFindInfoCode(14) <> "" And strFindInfoCode(14) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(14), "")
				End If
				If strFindInfoCode(15) <> "" And strFindInfoCode(15) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(15), "")
				End If
				If strFindInfoCode(16) <> "" And strFindInfoCode(16) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(16), "")
				End If
				If strFindInfoCode(17) <> "" And strFindInfoCode(17) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(17), "")
				End If
				If strFindInfoCode(18) <> "" And strFindInfoCode(18) <> "0" Then
					If strFindInfoCode(19) <> "" And strFindInfoCode(19) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(22), strFindInfoCode(19))
					End If
				End If
				If strFindInfoCode(20) <> "" And strFindInfoCode(20) <> "0" Then
					If strFindInfoCode(21) <> "" And strFindInfoCode(21) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(20), strFindInfoCode(21))
					End If
				End If
				TextContent = FormatContentUrl(TextContent, strRemoteListUrl)


				'--论坛帖子内容替换操作
				If Len(strReplace) > 0 Then
					TextContent = ReplaceClass(TextContent, strReplace)
					strComeFrom = ReplaceClass(strComeFrom, strReplace)
				End If


%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子标题:</font><%=strNewsTitle%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子内容:</font><%=TextContent%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子作者:</font><%=strAuthor%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子来源:</font><%=strComeFrom%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子更新时间:</font><%=datNewsTime%></td> 
  </tr> 

<%
	end if
%>

 <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%"><li>恭喜您！采集项目设置全部完成。<li/><br/>
	<li>如果要查看项目设置是否正确，请点击项目演示 <li/>
    </td>

  </tr>


  <tr bgcolor=#E8F1FF class=TBBG9 align="center"> 
    <td class="tar" width="25%">
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回上一页">&nbsp;&nbsp; 
      	<input name="B22" type="button" class="Button" onClick="window.location.href='admin_bbs_Gather.asp';" value="全部设置完成">&nbsp;&nbsp;
     	<input name="B32" type="button" class="Button" onClick="window.location.href='?action=begin&ChannelID=1&ItemID=4';" value="开始采集">&nbsp;&nbsp; 
    </td> 
  </tr> 

 </table>
		<%


End Function




Function main%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp">
  <p style="margin-left:15px;">
  <b>论坛帖子采集管理</b><br/><a href='admin_bbs_Gather.asp?Action=add'>添加</a>


</p>
<input type="hidden" name="SubmitFlag" value=yes>
  <table width="100%" border="0" align="center" cellpadding="5"  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
    <tr bgcolor="#eeeeee" class=TBBG9>  
      <td class="blu">ID</td>
      <td class="blu">名称</td>

      <td class="blu">操作</td>
    </tr>
<%
dim sql,h,i
	Response.cookies("music")("music")="admin_bbs_Gather.asp?page="&page&"&classid="&classid&"&specid="&specid
	Set Rs = Server.CreateObject("Adodb.Recordset")

	Sql = "SELECT * from bbs_Item  order by id desc"


	Rs.Open Sql,conn2,1,1
	Page = Request("Page")
	Rs.PageSize = PageSize
	if not (rs.bof and rs.eof)  then 
	IF Not IsEmpty(Page) Then
		IF Not IsNumeric(Page) Then		'判断Page是否为数字
			Page=1
		Else
			Page=Cint(Page)		'转换成短整形Integer
		End IF
		IF Page > Rs.PageCount Then
			Rs.AbsolutePage = Rs.PageCount	'设置当前显示页等于最后一页
		ElseIF Page <= 0 Then
			Rs.AbsolutePage = 1		'设置当前页等于第一页
		Else
			Rs.AbsolutePage = Page	'如果大于零,显示当前页等于接收的页数
		End IF
	Else
		Rs.AbsolutePage = 1
	End IF
	Page = Rs.AbsolutePage

	For i=1 to Rs.PageSize
		If Rs.Eof Then
			exit For
		End If
%>
    <tr bgcolor="#eeeeee" class=TBBG9> 
      <td width="10%"><%=rs("id")%></td>
      <td width="60%"><%=rs("name")%></td>

    <td width="30%">
<%
if rs("ok")>0 then
%>
<a href="admin_bbs_Gather.asp?Action=savenew&page=<%=rs("ok")%>&itemid=<%=rs("id")%>">继续采集</a> 
<%
end if

%>
<a href="admin_bbs_Gather.asp?Action=Begin&itemid=<%=rs("id")%>">采集</a> 
<a href="admin_bbs_Gather.asp?Action=yanshi&itemid=<%=rs("id")%>">演示</a> 
<a href="admin_bbs_Gather.asp?Action=ghost&itemid=<%=rs("id")%>">克隆</a> 
<a href="admin_bbs_Gather.asp?Action=edit&itemid=<%=rs("id")%>">修改</a> 
      <a href="admin_bbs_Gather.asp?Action=del&id=<%=rs("id")%>">删除</a>
    </td>
    </tr>
<%
		Rs.MoveNext
	Next	
   
%>
    <tr bgcolor=#E8F1FF class=TBBG9>
        <td  colspan="5" > <div align="center">
    <%
    if page>1 then       
        Response.Write("[<a href=admin_bbs_Gather.asp?Page=1>首页</a>]")
        Response.Write("[<a href=admin_bbs_Gather.asp?Page=" & (Page-1) & ">上一页</a>]")
    end if

    if page<Rs.PageCount then
        Response.Write("[<a href=admin_bbs_Gather.asp?Page=" & (Page+1) & ">下一页</a>]")
        Response.Write("[<a href=admin_bbs_Gather.asp?Page=" & Rs.PageCount & ">尾页</a>]")            
    end if
    Response.Write("[页次:<font color=red>" & page & "</font>/" & Rs.PageCount)    
    Response.Write("][共" & Rs.RecordCount & "条 <font color=red>"& Rs.PageSize & "</font>条/页]")
    if Rs.PageCount>2 then
	%><select onchange=javascript:window.location=(this.options[this.selectedIndex].value)>
	<%for n=1 to Rs.PageCount%>
	<option value="admin_bbs_Gather.asp&Page=<%=n%>" <%if page=n then Response.Write "selected"%>>第<%=n%>页</option>
	<%next%>
	</select>
	<%
    end if
%>

</table>
</form>
<%
	else
%>
    <tr bgcolor="#eeeeee" class=TBBG9> 
      <td  colspan="5" > <div align="center">
      	暂无采集,请添加!<br/><a href='admin_bbs_Gather.asp?Action=add'>添加</a>
       </div></td>
    </tr>
<%
	end if
		Rs.close
		set rs=nothing
%>

</table>
</form>
<%

End Function









Function edit
dim itemid
itemid=Request("itemid")
if not isnumeric(itemid) then itemid=""
if itemid<>""  then


if Request("SubmitFlag") = "" then
%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=edit&itemid=<%=itemid%>"  onSubmit='return CheckForm();'>
<%else%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=edit&itemid=<%=itemid%>">
<%end if%>

  <p style="margin-left:15px;">
  <b>添加论坛帖子采集项目&nbsp;&nbsp;-&nbsp;&nbsp;<%if Request("SubmitFlag") = "stp2" then%>设置第二步<%elseif Request("SubmitFlag") = "stp3" then%>设置第三步<%elseif Request("SubmitFlag") = "stp4" then%>设置第四步<%else%>设置第一步<%end if%></b>
  <br/><a href='admin_bbs_Gather.asp'>返回论坛帖子采集</a></p>
  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">

	<tr>
	<td align="center">
	<%
	If Request("SubmitFlag") = "stp2" Then
			editstp2
	ElseIf Request("SubmitFlag") = "stp3" Then
			editstp3
	ElseIf Request("SubmitFlag") = "stp4" Then
			editstp4
			exit Function
	Else
			editstp1
	End If
	%>
	<tr>
	<td bgcolor=#E8F1FF  align="center">
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回上一页">&nbsp;&nbsp; 
	<input type=submit name="B11" value=" 下一步 ">　
	<input name="ShowCode" type="checkbox" value="1"> 显示源码
	</td>
	</tr>
	</td></tr>
</table>
</form>
<%

end if

End Function







Function editstp1

dim itemid
itemid=TRim(Request("itemid"))
if not isnumeric(itemid) then itemid=""



			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then


%>
  <input type="hidden" name="SubmitFlag" value="stp2">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		
  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">项目名称:</td>
    <td><input name="name" type="text" value="<%=rs("name")%>" class=fminpt size="50" maxlength="50">
    </td>
  </tr>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">目标站点URL:</td>
    <td><input name="url" type="text"  value="<%=rs("url")%>" class=fminpt size="50" maxlength="255">
    </td>
  </tr>
   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">所属分类:</td>
    <td>
	<%set rs1=server.CreateObject("adodb.recordset")
	  sql1="SELECT * from qingtian_bbs where del=0 order by pid asc"
	  rs1.open sql1,conn,1,1
	  if not (rs1.bof and rs1.eof) then
	  For i=1 to rs1.RecordCount
		if i=1 then
		%><%if cint(rs("classid"))=rs1("id") then%><select name="classid" value="<%=rs("classid")%>"><%else%><select name="classid" value="<%=rs1("id")%>"><%end if%><option value=<%=rs("id")%><%if rs("classid")=rs1("id") then%> selected  <%end if%>><%=rs1("name")%></option><%
		else
		%><option value=<%=rs1("id")%><%if rs("classid")=rs1("id") then%> selected  <%end if%>><%=rs1("name")%></option><%
		end if
	  Rs1.MoveNext
	  Next

	  end if
	  Rs1.close
	  set rs1=nothing
	%>
    </select>
    </td>
  </tr>


   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">目标文档编码：</td>
    <td><select name="Encoding" value="<%=rs("Encoding")%>">
	<option value="GB2312" <%if rs("Encoding")="GB2312" then%> selected  <%end if%>>GB2312</option>

	<option value="UTF-8" <%if rs("Encoding")="UTF-8" then%> selected  <%end if%>>UTF-8</option>

	<option value="BIG5" <%if rs("Encoding")="BIG5" then%> selected  <%end if%>>BIG5</option>

    </select>
    </td>
  </tr>


   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">是否下载图片到本地：</td>
    <td>
	<input name="ImgDown" type="radio" value="0"  <%if rs("ImgDown")=0 then%> checked  <%end if%> > 否&nbsp;&nbsp;
      	<input type="radio" name="ImgDown" value="1"  <%if rs("ImgDown")=1 then%> checked  <%end if%> > 是 
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否显示为最新时间：</td>
    <td>
	<input name="IsNowTime" type="radio" value="0"  <%if rs("IsNowTime")=0 then%> checked  <%end if%>> 否&nbsp;&nbsp;
        <input type="radio" name="IsNowTime" value="1"  <%if rs("IsNowTime")=1 then%> checked  <%end if%>> 是</td>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">初始点击数：</td>
    <td>
	<input name="AllHits" type="text" id="AllHits"  value="<%=rs("Allhits")%>"  size="10" value="0">
    </td>
  </tr>

<%
RemoveCode=Split(rs("RemoveCode"), "|")
%>

  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">内容过滤设置：</td>
    <td>
      <input name="RemoveCode0" type="checkbox" value="1" <%if RemoveCode(0)=1 then%>checked<%end if%>> SCRIPT 
      <input name="RemoveCode1" type="checkbox" value="1" <%if RemoveCode(1)=1 then%>checked<%end if%>> IFARME 
      <input name="RemoveCode2" type="checkbox" value="1" <%if RemoveCode(2)=1 then%>checked<%end if%>> OBJECT 
      <input name="RemoveCode3" type="checkbox" value="1" <%if RemoveCode(3)=1 then%>checked<%end if%>> APPLET 
      <input name="RemoveCode4" type="checkbox" value="1" <%if RemoveCode(4)=1 then%>checked<%end if%>> DIV <br>
      <input name="RemoveCode5" type="checkbox" value="1" <%if RemoveCode(5)=1 then%>checked<%end if%>> FONT 
      <input name="RemoveCode6" type="checkbox" value="1" <%if RemoveCode(6)=1 then%>checked<%end if%>> SPAN 
      <input name="RemoveCode7" type="checkbox" value="1" <%if RemoveCode(7)=1 then%>checked<%end if%>> A 
      <input name="RemoveCode8" type="checkbox" value="1" <%if RemoveCode(8)=1 then%>checked<%end if%>> IMG 
      <input name="RemoveCode9" type="checkbox" value="1" <%if RemoveCode(9)=1 then%>checked<%end if%>> FORM 
      <input name="RemoveCode10" type="checkbox" value="1" <%if RemoveCode(10)=1 then%>checked<%end if%>> HTML 
    </td>
  </tr>


  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">远程列表URL：</td>
    <td><input name="RemoteListUrl"   value="<%=rs("Remotelisturl")%>" type="text" class=fminpt size="50" maxlength="255">
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否列表分页采集：</td>
    <td>
	<input name="IsPagination" type="radio" value="0" <%if rs("IsPagination")=0 then%>checked<%end if%> onClick="Pageinate1.style.display='none';Pageinate2.style.display='none';"> 否&nbsp;&nbsp;
      	<input type="radio" name="IsPagination" value="1" <%if rs("IsPagination")=1 then%>checked<%end if%> onClick="Pageinate1.style.display='';Pageinate2.style.display='';"> 是
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="Pageinate1" style="display:'none';"> 
    <td class="tar" width="25%">远程列表分页URL：</td>
    <td>
	<input name="PaginalList"  value="<%=rs("PaginalList")%>"  type="text" id="PaginalList" class=fminpt  size="50">
      	* 分页代码 <font color="red">{$pageid}</font>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="Pageinate2" style="display:'none';"> 
    <td class="tar" width="25%">远程列表起始页：</td>
    <td>
	开始页：<input name="startid" type="text"  value="<%=rs("startid")%>"  class=fminpt size="10" maxlength="255">&nbsp;-
   	结束页：<input name="lastid" type="text"  value="<%=rs("lastid")%>"  class=fminpt size="10" maxlength="255">&nbsp;
    	* 例如：1 - 9 或者 9 - 1
    </td>
  </tr>





   <tr bgcolor=#E8F1FF  > 
    <td class="tar" width="25%">内容字符替换操作：</td>
    <td>

<table border="0" cellpadding="3"><tr><td>
      <select name="strReplace" id="strReplace" style="width:380;height:100" size="2" ondblclick="return ModifyReplace();">
      <%if rs("strReplace")<>"" then

	strReplace=Split(rs("strReplace"),"$$$")
	for i=0 to ubound(strReplace)
      %><option value="<%=strReplace(i)%>"><%=strReplace(i)%></option><%
	next
      end if%>
      </select></td><td>
      <input type="button" name="addreplace" value="添加替换字符" class="button" onClick="AddReplace();"><br><br style="overflow: hidden; line-height: 5px">
      <input type="button" name="modifyreplace" value="修改当前字符" class="button" onClick="return ModifyReplace();"><br><br style="overflow: hidden; line-height: 5px">
      <input type="button" name="delreplace" value="删除当前字符" class="button" onClick="DelReplace();"><br>
      <input type="hidden" name="ReplaceList" value="">
        </td><tr></table>
    </td>
  </tr>







 </table>
		<%
			end if
			rs.Close
			Set rs = Nothing


End Function




Function editstp2
	dim flag,errmsg,name,title,url,user
	flag=1

	showcode=Request.Form("showcode")
	itemid=Request.Form("itemid")

	name=Request.Form("name")
	url=Request.Form("url")
	classid=Request.Form("classid")
	Encoding=Request.Form("Encoding")
	ImgDown=Request.Form("ImgDown")

	IsNowTime=Request.Form("IsNowTime")
	AllHits=Request.Form("AllHits")
	RemoveCode0=Request.Form("RemoveCode0")
	RemoveCode1=Request.Form("RemoveCode1")
	RemoveCode2=Request.Form("RemoveCode2")
	RemoveCode3=Request.Form("RemoveCode3")
	RemoveCode4=Request.Form("RemoveCode4")
	RemoveCode5=Request.Form("RemoveCode5")
	RemoveCode6=Request.Form("RemoveCode6")
	RemoveCode7=Request.Form("RemoveCode7")
	RemoveCode8=Request.Form("RemoveCode8")
	RemoveCode9=Request.Form("RemoveCode9")
	RemoveCode10=Request.Form("RemoveCode10")
	RemoteListUrl=Request.Form("RemoteListUrl")
	IsPagination=Request.Form("IsPagination")
	PaginalList=Request.Form("PaginalList")
	startid=Request.Form("startid")
	lastid=Request.Form("lastid")
	ReplaceList=Request.Form("ReplaceList")

	if Encoding="" then Encoding="GB2312"
	if ImgDown="" then ImgDown=0
	if IsNowTime="" then IsNowTime=0
	if AllHits="" then AllHits=0

	if IsPagination="" then IsPagination=0
	if startid="" then startid=0
	if lastid="" then lastid=0
	if RemoveCode0="" then RemoveCode0=0
	if RemoveCode1="" then RemoveCode1=0
	if RemoveCode2="" then RemoveCode2=0
	if RemoveCode3="" then RemoveCode3=0
	if RemoveCode4="" then RemoveCode4=0
	if RemoveCode5="" then RemoveCode5=0
	if RemoveCode6="" then RemoveCode6=0
	if RemoveCode7="" then RemoveCode7=0
	if RemoveCode8="" then RemoveCode8=0
	if RemoveCode9="" then RemoveCode9=0
	if RemoveCode10="" then RemoveCode10=0

	RemoveCode=RemoveCode0 & "|" & RemoveCode1 & "|" & RemoveCode2 & "|" & RemoveCode3 & "|" & RemoveCode4 & "|" & RemoveCode5 & "|" & RemoveCode6 & "|" & RemoveCode7 & "|" & RemoveCode8 & "|" & RemoveCode9 & "|" & RemoveCode10

	if name=""  then errmsg=errmsg&"项目名称不能为空\n":flag=0
	if classid=""  then errmsg=errmsg&"所属分类不能为空\n":flag=0
	if not isnumeric(classid) then errmsg=errmsg&"分类必须为数字\n":flag=0
	if url=""  then errmsg=errmsg&"目标站点URL不能为空\n":flag=0
	if RemoteListUrl=""  then errmsg=errmsg&"远程列表URL不能为空\n":flag=0



if flag<>0 then





			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&Itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs("name")=name
			rs("url")=url
			rs("classid")=classid
			rs("Encoding")=Encoding
			rs("ImgDown")=ImgDown

			rs("IsNowTime")=IsNowTime
			rs("RemoveCode")=RemoveCode
			rs("RemoteListUrl")=RemoteListUrl
			rs("IsPagination")=IsPagination
			rs("startid")=startid
			rs("lastid")=lastid
			rs("strReplace")=ReplaceList
			rs("PaginalList")=PaginalList
			rs.update()







			FindListCode=Split(rs("FindListCode"), "$$$")


%>
  <input type="hidden" name="SubmitFlag" value="stp3">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>

<%
	if showcode=1 then
		HTTPHtmlCode=GetRemoteData(Trim(RemoteListUrl), Trim(Encoding))
		If HTTPHtmlCode = "" Then
			Response.Write "<script language=javascript>" & vbCrLf
			Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
			Response.Write "history.go(-1);" & vbCrLf
			Response.Write "</script>" & vbCrLf
		End If%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><textarea name='content' id='content' wrap='OFF' style='width:100%;' rows='20'><%=Server.HTMLEncode(HTTPHtmlCode)%></textarea><div align='right'><a href="javascript:admin_Size(-20,'content')"><img src='images/minus.gif' unselectable=on border=0></a> <a href="javascript:admin_Size(20,'content')"><img src='images/plus.gif' unselectable=on border=0></div></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2">采集的目标地址 → <a href='<%=RemoteListUrl%>' target='_blank'><font color='red'><%=RemoteListUrl%></font></a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='view-source:<%=RemoteListUrl%>' target='_blank'><font color='blue'>点击查看目标源代码</font></a></td> 
  </tr> 

<%
	end if


%>


  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取列表开始代码:</td>
    <td>
	<textarea name=FindListCode0 rows=5 cols=80><%=FindListCode(0)%></textarea>
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取列表结束代码:</td>
    <td>
	<textarea name=FindListCode1 rows=5 cols=80><%=FindListCode(1)%></textarea>
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取连接开始代码:</td>
    <td>
	<textarea name=FindListCode2 rows=5 cols=80><%=FindListCode(2)%></textarea></td> 
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取连接结束代码:</td>
    <td>
	<textarea name=FindListCode3 rows=5 cols=80><%=FindListCode(3)%></textarea>
    </td>
  </tr>




 </table>
		<%










			end if
			rs.Close
			Set rs = Nothing









	else
	Response.Write "<script language=javascript>" & vbCrLf
	Response.Write "alert('"&errmsg&"');"
	Response.Write "history.go(-1);" & vbCrLf
	Response.Write "</script>" & vbCrLf
		
	end if	
End Function




Function editstp3
	dim flag,errmsg,name,title,url,user
	flag=1

	itemid=Request.Form("itemid")
	showcode=Request.Form("showcode")


	FindListCode0=Request.Form("FindListCode0")
	FindListCode1=Request.Form("FindListCode1")
	FindListCode2=Request.Form("FindListCode2")
	FindListCode3=Request.Form("FindListCode3")


	if FindListCode0="" then FindListCode0=0
	if FindListCode1="" then FindListCode1=0
	if FindListCode2="" then FindListCode2=0
	if FindListCode3="" then FindListCode3=0


	FindListCode=FindListCode0 & "$$$" & FindListCode1 & "$$$" & FindListCode2 & "$$$" & FindListCode3


	strFindListCode = Split(ReplaceTrim(FindListCode), "$$$")

			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs("FindListCode")=FindListCode
			RemoteListUrl=rs("RemoteListUrl")
			Encoding=rs("Encoding")
			rs.update()







			FindInfoCode=Split(rs("FindInfoCode"), "$$$")






%>
  <input type="hidden" name="SubmitFlag" value="stp4">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>


<%
	if showcode=1 then
		HTTPHtmlCode=ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Trim(Encoding)))
		If HTTPHtmlCode = "" Then
			Response.Write "<script language=javascript>" & vbCrLf
			Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
			Response.Write "history.go(-1);" & vbCrLf
			Response.Write "</script>" & vbCrLf
		End If


				'--获取远程列表代码
				strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
				strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
				If strRemoteLisCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程列表出错！请确定你的远程列表开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				'--获取列表URL
				strRemoteListUrl = CutFixed(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
				strRemoteListUrl = FormatRemoteUrl(RemoteListUrl, strRemoteListUrl)
				If strRemoteListUrl = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程连接出错！请确定你的连接开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				HTTPHtmlCode = GetRemoteData(strRemoteListUrl, Encoding)
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><textarea name='content' id='content' wrap='OFF' style='width:100%;' rows='20'><%=Server.HTMLEncode(HTTPHtmlCode)%></textarea><div align='right'><a href="javascript:admin_Size(-20,'content')"><img src='images/minus.gif' unselectable=on border=0></a> <a href="javascript:admin_Size(20,'content')"><img src='images/plus.gif' unselectable=on border=0></div></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2">采集的目标地址 → <a href='<%=strRemoteListUrl%>' target='_blank'><font color='red'><%=strRemoteListUrl%></font></a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='view-source:<%=strRemoteListUrl%>' target='_blank'><font color='blue'>点击查看目标源代码</font></a></td> 
  </tr> 

<%
	end if
%>


  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子标题开始代码:</td>
    <td>
	<textarea name=FindInfoCode0 rows=5 cols=80><%=FindInfoCode(0)%></textarea>
    </td>
  </tr>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子标题结束代码:</td>
    <td>
	<textarea name=FindInfoCode1 rows=5 cols=80><%=FindInfoCode(1)%></textarea>
    </td>
  </tr>


  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子内容开始代码:</td>
    <td>
	<textarea name=FindInfoCode2 rows=5 cols=80><%=FindInfoCode(2)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">获取论坛帖子内容结束代码:</td>
    <td>
	<textarea name=FindInfoCode3 rows=5 cols=80><%=FindInfoCode(3)%></textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">论坛帖子作者设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont1" onClick="InfoCode1.style.display='none';InfoCode2.style.display='none';" <%if FindInfoCode(4)="" or FindInfoCode(4)="0"  then%>checked<%end if%>> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont1" onClick="InfoCode1.style.display='';InfoCode2.style.display='';" <%if FindInfoCode(4)<>"" and FindInfoCode(4)<>"0"  then%>checked<%end if%>>打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果指定作者,开始代码填“0”，结束代码填作者名称</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode1"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子作者开始代码：</td>
    <td>
	<textarea name=FindInfoCode4 rows=5 cols=80><%=FindInfoCode(4)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode2"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子作者结束代码：</td>
    <td>
	<textarea name=FindInfoCode5 rows=5 cols=80><%=FindInfoCode(5)%></textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">论坛帖子来源设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont2" onClick="InfoCode3.style.display='none';InfoCode4.style.display='none';"  <%if FindInfoCode(6)="" or FindInfoCode(6)="0"  then%>checked<%end if%>> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont2" onClick="InfoCode3.style.display='';InfoCode4.style.display='';" <%if FindInfoCode(6)<>"" and FindInfoCode(6)<>"0"  then%>checked<%end if%>>打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果要指定来源,开始代码填“0”，结束代码填来源</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode3"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子来源开始代码：</td>
    <td>
	<textarea name=FindInfoCode6 rows=5 cols=80><%=FindInfoCode(6)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode4"  style="display:'none';"> 
    <td class="tar" width="25%">获取论坛帖子来源结束代码：</td>
    <td>
	<textarea name=FindInfoCode7 rows=5 cols=80><%=FindInfoCode(7)%></textarea>
    </td>
  </tr>





  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">论坛帖子更新时间设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont3" onClick="InfoCode5.style.display='none';InfoCode6.style.display='none';"  <%if FindInfoCode(8)="" or FindInfoCode(8)="0"  then%>checked<%end if%>> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont3" onClick="InfoCode5.style.display='';InfoCode6.style.display='';" <%if FindInfoCode(8)<>"" and FindInfoCode(8)<>"0"  then%>checked<%end if%>>打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果第一步设置显示为最新时间，此设置无效</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode5"  style="display:'none';"> 
    <td class="tar" width="25%">获取更新时间开始代码：</td>
    <td>
	<textarea name=FindInfoCode8 rows=5 cols=80><%=FindInfoCode(8)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode6"  style="display:'none';"> 
    <td class="tar" width="25%">获取更新时间结束代码：</td>
    <td>
	<textarea name=FindInfoCode9 rows=5 cols=80><%=FindInfoCode(9)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">是否内容分页采集：</td>
    <td>
	<Input type="radio" value="0" name="selfont4" onClick="InfoCode7.style.display='none';InfoCode8.style.display='none';InfoCode9.style.display='none';InfoCode10.style.display='none';" <%if FindInfoCode(10)="" or FindInfoCode(10)="0" or rs("IsNextPage")=0 then%>checked<%end if%>> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont4" onClick="InfoCode7.style.display='';InfoCode8.style.display='';InfoCode9.style.display='';InfoCode10.style.display='';" <%if FindInfoCode(10)<>"" and FindInfoCode(10)<>"0"  and rs("IsNextPage")=1  then%>checked<%end if%>>打开设置窗口&nbsp;&nbsp;
	<font color='blue'>* 如果内容有分页，请设置此项</font>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode7"  style="display:'none';"> 
    <td class="tar" width="25%">内容分页列表开始代码：</td>
    <td>
	<textarea name=FindInfoCode10 rows=5 cols=80><%=FindInfoCode(10)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode8"  style="display:'none';"> 
    <td class="tar" width="25%">内容分页列表结束代码：</td>
    <td>
	<textarea name=FindInfoCode11 rows=5 cols=80><%=FindInfoCode(11)%></textarea>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode9"  style="display:'none';"> 
    <td class="tar" width="25%">获取分页连接开始代码：</td>
    <td>
	<textarea name=FindInfoCode12 rows=5 cols=80><%=FindInfoCode(12)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode10"  style="display:'none';"> 
    <td class="tar" width="25%">获取分页连接结束代码：</td>
    <td>
	<textarea name=FindInfoCode13 rows=5 cols=80><%=FindInfoCode(13)%></textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">内容过滤设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont5" onClick="InfoCode11.style.display='none';InfoCode12.style.display='none';InfoCode13.style.display='none';InfoCode14.style.display='none';"  <%if FindInfoCode(14)="" or FindInfoCode(14)="0"  then%>checked<%end if%>> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont5" onClick="InfoCode11.style.display='';InfoCode12.style.display='';InfoCode13.style.display='';InfoCode14.style.display='';" <%if FindInfoCode(14)<>"" and FindInfoCode(14)<>"0"  then%>checked<%end if%>>打开设置窗口&nbsp;&nbsp;
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode11"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符一：</td>
    <td>
	<textarea name=FindInfoCode14 rows=5 cols=80><%=FindInfoCode(14)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode12"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符二：</td>
    <td>
	<textarea name=FindInfoCode15 rows=5 cols=80><%=FindInfoCode(15)%></textarea>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode13"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符三：</td>
    <td>
	<textarea name=FindInfoCode16 rows=5 cols=80><%=FindInfoCode(16)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode14"  style="display:'none';"> 
    <td class="tar" width="25%">内容过虑字符四：</td>
    <td>
	<textarea name=FindInfoCode17 rows=5 cols=80><%=FindInfoCode(17)%></textarea>
    </td>
  </tr>




  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td class="tar" width="25%">匹配字符设置：</td>
    <td>
	<Input type="radio" value="0" name="selfont6" onClick="InfoCode15.style.display='none';InfoCode16.style.display='none';InfoCode17.style.display='none';InfoCode18.style.display='none';"  <%if FindInfoCode(18)="" or FindInfoCode(18)="0"  then%>checked<%end if%>> 隐藏设置窗口&nbsp;&nbsp;
	<Input type="radio" value="1" name="selfont6" onClick="InfoCode15.style.display='';InfoCode16.style.display='';InfoCode17.style.display='';InfoCode18.style.display='';" <%if FindInfoCode(18)<>"" and FindInfoCode(18)<>"0"  then%>checked<%end if%>>打开设置窗口&nbsp;&nbsp;
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode15"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤一开始代码：</td>
    <td>
	<textarea name=FindInfoCode18 rows=5 cols=80><%=FindInfoCode(18)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode16"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤一结束代码：</td>
    <td>
	<textarea name=FindInfoCode19 rows=5 cols=80><%=FindInfoCode(19)%></textarea>
    </td>
  </tr>

  <tr bgcolor=#f7f7f7 class=TBBG9 id="InfoCode17"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤二开始代码：</td>
    <td>
	<textarea name=FindInfoCode20 rows=5 cols=80><%=FindInfoCode(20)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9  id="InfoCode18"  style="display:'none';"> 
    <td class="tar" width="25%">匹配字符过滤二结束代码：</td>
    <td>
	<textarea name=FindInfoCode21 rows=5 cols=80><%=FindInfoCode(21)%></textarea>
    </td>
  </tr>



  <tr bgcolor=#f7f7f7 class=TBBG9 > 
    <td class="tar" width="25%">指定演示URL：</td>
    <td>
	<input type="text" name=NamedDemourl size=80 value='<%=rs("NamedDemourl")%>'>
    </td>
  </tr>



 </table>
		<%



			end if
			rs.Close
			Set rs = Nothing








End Function





Function editstp4
	dim flag,errmsg,name,title,url,user
	flag=1

	itemid=Request.Form("itemid")
	showcode=Request.Form("showcode")
	NamedDemourl=Request.Form("NamedDemourl")
	FindInfoCode0=Request.Form("FindInfoCode0")
	FindInfoCode1=Request.Form("FindInfoCode1")
	FindInfoCode2=Request.Form("FindInfoCode2")
	FindInfoCode3=Request.Form("FindInfoCode3")
	FindInfoCode4=Request.Form("FindInfoCode4")
	FindInfoCode5=Request.Form("FindInfoCode5")
	FindInfoCode6=Request.Form("FindInfoCode6")
	FindInfoCode7=Request.Form("FindInfoCode7")
	FindInfoCode8=Request.Form("FindInfoCode8")
	FindInfoCode9=Request.Form("FindInfoCode9")
	FindInfoCode10=Request.Form("FindInfoCode10")
	FindInfoCode11=Request.Form("FindInfoCode11")
	FindInfoCode12=Request.Form("FindInfoCode12")
	FindInfoCode13=Request.Form("FindInfoCode13")
	FindInfoCode14=Request.Form("FindInfoCode14")
	FindInfoCode15=Request.Form("FindInfoCode15")
	FindInfoCode16=Request.Form("FindInfoCode16")
	FindInfoCode17=Request.Form("FindInfoCode17")
	FindInfoCode18=Request.Form("FindInfoCode18")
	FindInfoCode19=Request.Form("FindInfoCode19")
	FindInfoCode20=Request.Form("FindInfoCode20")
	FindInfoCode21=Request.Form("FindInfoCode21")
	FindInfoCode22=Request.Form("FindInfoCode22")
	IsNextPage=Request.Form("selfont4")

	if FindInfoCode0="" then FindInfoCode0=0
	if FindInfoCode1="" then FindInfoCode1=0
	if FindInfoCode2="" then FindInfoCode2=0
	if FindInfoCode3="" then FindInfoCode3=0
	if FindInfoCode4="" then FindInfoCode4=0
	if FindInfoCode5="" then FindInfoCode5=0
	if FindInfoCode6="" then FindInfoCode6=0
	if FindInfoCode7="" then FindInfoCode7=0
	if FindInfoCode8="" then FindInfoCode8=0
	if FindInfoCode9="" then FindInfoCode9=0
	if FindInfoCode10="" then FindInfoCode10=0
	if FindInfoCode11="" then FindInfoCode11=0
	if FindInfoCode12="" then FindInfoCode12=0
	if FindInfoCode13="" then FindInfoCode13=0
	if FindInfoCode14="" then FindInfoCode14=0
	if FindInfoCode15="" then FindInfoCode15=0
	if FindInfoCode16="" then FindInfoCode16=0
	if FindInfoCode17="" then FindInfoCode17=0
	if FindInfoCode18="" then FindInfoCode18=0
	if FindInfoCode19="" then FindInfoCode19=0
	if FindInfoCode20="" then FindInfoCode20=0
	if FindInfoCode21="" then FindInfoCode21=0
	if FindInfoCode22="" then FindInfoCode22=0



	FindInfoCode=FindInfoCode0 & "$$$" & FindInfoCode1 & "$$$" & FindInfoCode2 & "$$$" & FindInfoCode3 & "$$$" & FindInfoCode4 & "$$$" & FindInfoCode5 & "$$$" & FindInfoCode6 & "$$$" & FindInfoCode7 & "$$$" & FindInfoCode8 & "$$$" & FindInfoCode9 & "$$$" & FindInfoCode10 & "$$$" & FindInfoCode11 & "$$$" & FindInfoCode12 & "$$$" & FindInfoCode13 & "$$$" & FindInfoCode14 & "$$$" & FindInfoCode15 & "$$$" & FindInfoCode16 & "$$$" & FindInfoCode17 & "$$$" & FindInfoCode18 & "$$$" & FindInfoCode19 & "$$$" & FindInfoCode20 & "$$$" & FindInfoCode21 & "$$$" & FindInfoCode22




			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs("FindInfoCode")=FindInfoCode
			rs("NamedDemourl")=NamedDemourl
			RemoteListUrl=rs("RemoteListUrl")
			Encoding=rs("Encoding")
			RemoveCode=rs("RemoveCode")
			rs("IsNextPage")=IsNextPage
			strFindListCode = Split(ReplaceTrim(rs("FindListCode")), "$$$")
			rs.update()
			end if
			rs.Close
			Set rs = Nothing






	strFindInfoCode = Split(ReplaceTrim(FindInfoCode), "$$$")


















%>
  <input type="hidden" name="SubmitFlag" value="stp3">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
 

<%
	if showcode=1 then
		if NamedDemourl ="" then
			HTTPHtmlCode=ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Trim(Encoding)))
			If HTTPHtmlCode = "" Then
				Response.Write "<script language=javascript>" & vbCrLf
				Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
				Response.Write "history.go(-1);" & vbCrLf
				Response.Write "</script>" & vbCrLf
			End If


				'--获取远程列表代码
				strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
				strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
				If strRemoteLisCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程列表出错！请确定你的远程列表开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				'--获取列表URL
				strRemoteListUrl = CutFixed(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
				strRemoteListUrl = FormatRemoteUrl(RemoteListUrl, strRemoteListUrl)
				If strRemoteListUrl = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程连接出错！请确定你的连接开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				HTTPHtmlCode = GetRemoteData(strRemoteListUrl, Encoding)
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If

		else
			strRemoteListUrl=NamedDemourl
		end if

				HTTPHtmlCode = ReplaceTrim(GetRemoteData(strRemoteListUrl, Encoding))
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				
				'--获取论坛帖子标题
				strNewsTitle = CutFixed(HTTPHtmlCode, strFindInfoCode(0), strFindInfoCode(1))
				strNewsTitle = Trim(CheckHTML(strNewsTitle))
				If Len(strNewsTitle) = 0 Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取标题代码出错！请确定你的代码输入正确。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				


				'--获取论坛帖子内容
				NewsContent = CutFixed(HTTPHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
				If Len(NewsContent) = 0 Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取论坛帖子内容代码出错！请确定你的代码输入正确。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If


				
				'--获取论坛帖子作者
				If strFindInfoCode(4) <> "" And strFindInfoCode(4) <> "0" Then
					startcode = Replace(Replace(Replace(strFindInfoCode(4), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
					lastcode = Replace(Replace(Replace(strFindInfoCode(5), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
					strAuthor = CutFixed(HTTPHtmlCode, startcode, lastcode)
					strAuthor = CheckHTML(Trim(strAuthor))
				Else
					If strFindInfoCode(5) <> "" And strFindInfoCode(5) <> "0" Then
						strAuthor = Trim(strFindInfoCode(5))
					Else
						strAuthor = "佚名"
					End If
				End If
				

				'--获取论坛帖子来源
				If strFindInfoCode(6) <> "" And strFindInfoCode(6) <> "0" Then
					startcode = Replace(Replace(Replace(Replace(strFindInfoCode(6), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
					lastcode = Replace(Replace(Replace(Replace(strFindInfoCode(7), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
					strComeFrom = CutFixed(HTTPHtmlCode, startcode, lastcode)
					strComeFrom = CheckHTML(Trim(strComeFrom))
				Else
					If strFindInfoCode(7) <> "" And strFindInfoCode(7) <> "0" Then
						strComeFrom = Trim(strFindInfoCode(7))
					Else
						strComeFrom = "本站整理"
					End If
				End If
				
				'--获取论坛帖子更新时间
				If strFindInfoCode(8) <> "" And strFindInfoCode(8) <> "0" Then
					startcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(8), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
					lastcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(9), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
					datNewsTime = CutFixed(HTTPHtmlCode, startcode, lastcode)
					datNewsTime = CheckHTML(datNewsTime)
					datNewsTime = CheckNostr(datNewsTime)
					datNewsTime = Formatime(Trim(datNewsTime))
				Else
					datNewsTime = Now
				End If


		'--------------获取分页内容部分开始-----------------
				Dim n, strTempArray
				If CInt(IsNextPage) > 0 And strFindInfoCode(10) <> "" And strFindInfoCode(10) <> "0" And strFindInfoCode(11) <> "" And strFindInfoCode(11) <> "0" Then
					'-- 分页方法
					
					If strFindInfoCode(12) <> "" And strFindInfoCode(12) <> "0" And strFindInfoCode(13) <> "" And strFindInfoCode(13) <> "0" Then
						'--从内容中读取分页获取列表
						strAddedCode = CutFixate(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
						strAddedCode = ReplaceTrim(strAddedCode)
						If Len(strAddedCode) = 0 Then
							'--从整个HTML代码中获取列表
							strAddedCode = CutFixate(HTTPHtmlCode, strFindInfoCode(10), strFindInfoCode(11))
							strAddedCode = ReplaceTrim(strAddedCode)
						End If
						
						'--如果可以获取分页列表,开始获取分页URL
						If Len(strAddedCode) > 0 Then
							strAddedlist = FindMatch(strAddedCode, strFindInfoCode(12), strFindInfoCode(13))
							'--判断是否获取到URL
							If Len(strAddedlist) > 0 Then
								strTempContent = ""
								'--把所有URL分割成数组
								AddedlistArray = Split(strAddedlist, "|||")
								For i = 0 To UBound(AddedlistArray)
									'--格式化URL成绝对路径
									PaginationUrl = FormatRemoteUrl(strRemoteListUrl, AddedlistArray(i))
									'--只有URL和当前URL不一样的时候才采集分页信息
									If Len(PaginationUrl) > 8 And LCase(PaginationUrl) <> LCase(strRemoteListUrl) Then
										TempHtmlCode = ReplaceTrim(GetRemoteData(PaginationUrl, strEncoding))
										If Len(TempHtmlCode) > 10 Then
											TempContent = CutFixed(TempHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
											If Len(TempContent) > 0 Then
												'--将获取到分页内容写入到一个临时变量
												strTempContent = strTempContent & "[page_break]" & TempContent
											End If
										End If
									End If
								Next
								NewsContent = NewsContent & strTempContent
								NewsContent = CheckMatch(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
								NewsContent = Replace(NewsContent, "[page_break]", "<br/><span style=""color:red;font-size:12px;font-family:tahoma;font-weight:bold;""><font color='red'>此处是内容分页标签：</font>[page_break]</span><br/>")
							End If
						End If
					End If
				End If


				'--内容过滤
				TextContent = Html2Ubb(NewsContent, RemoveCode)
				If strFindInfoCode(14) <> "" And strFindInfoCode(14) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(14), "")
				End If
				If strFindInfoCode(15) <> "" And strFindInfoCode(15) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(15), "")
				End If
				If strFindInfoCode(16) <> "" And strFindInfoCode(16) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(16), "")
				End If
				If strFindInfoCode(17) <> "" And strFindInfoCode(17) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(17), "")
				End If
				If strFindInfoCode(18) <> "" And strFindInfoCode(18) <> "0" Then
					If strFindInfoCode(19) <> "" And strFindInfoCode(19) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(22), strFindInfoCode(19))
					End If
				End If
				If strFindInfoCode(20) <> "" And strFindInfoCode(20) <> "0" Then
					If strFindInfoCode(21) <> "" And strFindInfoCode(21) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(20), strFindInfoCode(21))
					End If
				End If
				TextContent = FormatContentUrl(TextContent, strRemoteListUrl)


				'--论坛帖子内容替换操作
				If Len(strReplace) > 0 Then
					TextContent = ReplaceClass(TextContent, strReplace)
					strComeFrom = ReplaceClass(strComeFrom, strReplace)
				End If

				TextContent=toHTML(TextContent)
				if instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com")>0 then
					if instrREV(TextContent,"[b][url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com")) >0 then
						TextContent=left(TextContent,instrREV(TextContent,"[b][url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com"))-1)
					elseif instrREV(TextContent,"[url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com")) >0 then
						TextContent=left(TextContent,instrREV(TextContent,"[url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com"))-1)
					end if
				end if
%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子标题:</font><%=strNewsTitle%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子内容:</font><%=TextContent%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子作者:</font><%=strAuthor%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子来源:</font><%=strComeFrom%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子更新时间:</font><%=datNewsTime%></td> 
  </tr> 

<%
	end if
%>

 <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%"><li>恭喜您！采集项目设置全部完成。<li/><br/>
	<li>如果要查看项目设置是否正确，请点击项目演示 <li/>
    </td>

  </tr>


  <tr bgcolor=#E8F1FF class=TBBG9 align="center"> 
    <td class="tar" width="25%">
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回上一页">&nbsp;&nbsp; 
      	<input name="B22" type="button" class="Button" onClick="window.location.href='admin_bbs_Gather.asp';" value="全部设置完成">&nbsp;&nbsp;
     	<input name="B32" type="button" class="Button" onClick="window.location.href='?action=begin&ChannelID=1&ItemID=4';" value="开始采集">&nbsp;&nbsp; 
    </td> 
  </tr> 

 </table>
		<%


End Function













Function yanshi
	dim flag,errmsg,name,title,url,user
	flag=1



	itemid=Request("itemid")


			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,1
			if not (rs.bof and rs.eof) then

			FindInfoCode=rs("FindInfoCode")
			NamedDemourl=rs("NamedDemourl")
			RemoteListUrl=rs("RemoteListUrl")
			Encoding=rs("Encoding")
			RemoveCode=rs("RemoveCode")
			IsNextPage=rs("IsNextPage")
			strFindListCode = Split(ReplaceTrim(rs("FindListCode")), "$$$")
			strFindInfoCode = Split(ReplaceTrim(rs("FindInfoCode")), "$$$")

			end if
			rs.Close
			Set rs = Nothing























%>
  <input type="hidden" name="SubmitFlag" value="stp3">
  <input type="hidden" name="itemid" value="<%=itemid%>">
		


  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
 

<%

		if NamedDemourl ="" then
			HTTPHtmlCode=ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Trim(Encoding)))
			If HTTPHtmlCode = "" Then
				Response.Write "<script language=javascript>" & vbCrLf
				Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
				Response.Write "history.go(-1);" & vbCrLf
				Response.Write "</script>" & vbCrLf
			End If


				'--获取远程列表代码
				strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
				strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
				If strRemoteLisCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程列表出错！请确定你的远程列表开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				'--获取列表URL
				strRemoteListUrl = CutFixed(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
				strRemoteListUrl = FormatRemoteUrl(RemoteListUrl, strRemoteListUrl)
				If strRemoteListUrl = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程连接出错！请确定你的连接开始和结束代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				HTTPHtmlCode = GetRemoteData(strRemoteListUrl, Encoding)
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If

		else
			strRemoteListUrl=NamedDemourl
		end if

				HTTPHtmlCode = ReplaceTrim(GetRemoteData(strRemoteListUrl, Encoding))
				If HTTPHtmlCode = "" Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取远程信息出错！请确定你的远程连接代码输入无误。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				
				HTTPHtmlCode = FormatContentUrl(HTTPHtmlCode, strRemoteListUrl)

				'--获取论坛帖子标题
				strNewsTitle = CutFixed(HTTPHtmlCode, strFindInfoCode(0), strFindInfoCode(1))
				strNewsTitle = Trim(CheckHTML(strNewsTitle))
				If Len(strNewsTitle) = 0 Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取标题代码出错！请确定你的代码输入正确。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If
				


				'--获取论坛帖子内容
				NewsContent = CutFixed(HTTPHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
				If Len(NewsContent) = 0 Then
					Response.Write "<script language=javascript>" & vbCrLf
					Response.Write "alert('获取论坛帖子内容代码出错！请确定你的代码输入正确。');"
					Response.Write "history.go(-1);" & vbCrLf
					Response.Write "</script>" & vbCrLf
				End If


				
				'--获取论坛帖子作者
				If strFindInfoCode(4) <> "" And strFindInfoCode(4) <> "0" Then
					startcode = Replace(Replace(Replace(strFindInfoCode(4), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
					lastcode = Replace(Replace(Replace(strFindInfoCode(5), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
					strAuthor = CutFixed(HTTPHtmlCode, startcode, lastcode)
					strAuthor = CheckHTML(Trim(strAuthor))
				Else
					If strFindInfoCode(5) <> "" And strFindInfoCode(5) <> "0" Then
						strAuthor = Trim(strFindInfoCode(5))
					Else
						strAuthor = "佚名"
					End If
				End If
				

				'--获取论坛帖子来源
				If strFindInfoCode(6) <> "" And strFindInfoCode(6) <> "0" Then
					startcode = Replace(Replace(Replace(Replace(strFindInfoCode(6), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
					lastcode = Replace(Replace(Replace(Replace(strFindInfoCode(7), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
					strComeFrom = CutFixed(HTTPHtmlCode, startcode, lastcode)
					strComeFrom = CheckHTML(Trim(strComeFrom))
				Else
					If strFindInfoCode(7) <> "" And strFindInfoCode(7) <> "0" Then
						strComeFrom = Trim(strFindInfoCode(7))
					Else
						strComeFrom = "本站整理"
					End If
				End If
				
				'--获取论坛帖子更新时间
				If strFindInfoCode(8) <> "" And strFindInfoCode(8) <> "0" Then
					startcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(8), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
					lastcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(9), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
					datNewsTime = CutFixed(HTTPHtmlCode, startcode, lastcode)
					datNewsTime = CheckHTML(datNewsTime)
					datNewsTime = CheckNostr(datNewsTime)
					datNewsTime = Formatime(Trim(datNewsTime))
				Else
					datNewsTime = Now
				End If


		'--------------获取分页内容部分开始-----------------
				Dim n, strTempArray
				If CInt(IsNextPage) > 0 And strFindInfoCode(10) <> "" And strFindInfoCode(10) <> "0" And strFindInfoCode(11) <> "" And strFindInfoCode(11) <> "0" Then
					'-- 分页方法
					
					If strFindInfoCode(12) <> "" And strFindInfoCode(12) <> "0" And strFindInfoCode(13) <> "" And strFindInfoCode(13) <> "0" Then
						'--从内容中读取分页获取列表
						strAddedCode = CutFixate(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
						strAddedCode = ReplaceTrim(strAddedCode)
						If Len(strAddedCode) = 0 Then
							'--从整个HTML代码中获取列表
							strAddedCode = CutFixate(HTTPHtmlCode, strFindInfoCode(10), strFindInfoCode(11))
							strAddedCode = ReplaceTrim(strAddedCode)
						End If
						
						strAddedCode = ReplaceTrim(strAddedCode)
						'--如果可以获取分页列表,开始获取分页URL
						If Len(strAddedCode) > 0 Then
							strAddedlist = FindMatch(strAddedCode, strFindInfoCode(12), strFindInfoCode(13))
							'--判断是否获取到URL
							If Len(strAddedlist) > 0 Then
								strTempContent = ""
								'--把所有URL分割成数组
								AddedlistArray = Split(strAddedlist, "|||")
								For i = 0 To UBound(AddedlistArray)
									'--格式化URL成绝对路径
									PaginationUrl = FormatRemoteUrl(strRemoteListUrl, AddedlistArray(i))
									'--只有URL和当前URL不一样的时候才采集分页信息
									If Len(PaginationUrl) > 8 And LCase(PaginationUrl) <> LCase(strRemoteListUrl) Then
										TempHtmlCode = ReplaceTrim(GetRemoteData(PaginationUrl, strEncoding))
										If Len(TempHtmlCode) > 10 Then
											TempContent = CutFixed(TempHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
											If Len(TempContent) > 0 Then
												'--将获取到分页内容写入到一个临时变量
												strTempContent = strTempContent & "[page_break]" & TempContent
											End If
										End If
									End If
								Next
								NewsContent = NewsContent & strTempContent
								NewsContent = CheckMatch(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
								NewsContent = Replace(NewsContent, "[page_break]", "<br /><span style=""color:red;font-size:12px;font-family:tahoma;font-weight:bold;""><font color='red'>此处是内容分页标签：[page_break]</font></span><br />")
							End If
						End If
					End If
				End If


				'--内容过滤
				'TextContent = NewsContent
				TextContent = Html2Ubb(NewsContent, RemoveCode)
				If strFindInfoCode(14) <> "" And strFindInfoCode(14) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(14), "")
				End If
				If strFindInfoCode(15) <> "" And strFindInfoCode(15) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(15), "")
				End If
				If strFindInfoCode(16) <> "" And strFindInfoCode(16) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(16), "")
				End If
				If strFindInfoCode(17) <> "" And strFindInfoCode(17) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(17), "")
				End If
				If strFindInfoCode(18) <> "" And strFindInfoCode(18) <> "0" Then
					If strFindInfoCode(19) <> "" And strFindInfoCode(19) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(22), strFindInfoCode(19))
					End If
				End If
				If strFindInfoCode(20) <> "" And strFindInfoCode(20) <> "0" Then
					If strFindInfoCode(21) <> "" And strFindInfoCode(21) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(20), strFindInfoCode(21))
					End If
				End If



				'--论坛帖子内容替换操作
				If Len(strReplace) > 0 Then
					TextContent = ReplaceClass(TextContent, strReplace)
					strComeFrom = ReplaceClass(strComeFrom, strReplace)
				End If
				TextContent = FormatContentUrl(TextContent, strRemoteListUrl)
				if instr(TextContent,".html"">上一页</a>&nbsp;&nbsp;<a href=""http://wap.qt3g.com/")>0 then TextContent=left(TextContent,instrREV(TextContent,"</div>",instr(TextContent,".html"">上一页</a>&nbsp;&nbsp;<a href=""http://wap.qt3g.com/"))-1)

%>

  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td align="center" colspan="2">项 目 编 辑 -- 采集目标网站源代码&nbsp;&nbsp;&nbsp;&nbsp;<Input type="radio" value="0" name="soucode" onClick="soucodeid.style.display='none';"> 关闭源代码窗口&nbsp;&nbsp;<Input type="radio" value="1" name="soucode" onClick="soucodeid.style.display='';" checked> 查看源代码        </td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子标题:</font><%=strNewsTitle%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子内容:</font><%=TextContent%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子作者:</font><%=strAuthor%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子来源:</font><%=strComeFrom%></td> 
  </tr> 
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td colspan="2" id='soucodeid'><font color='red'>论坛帖子更新时间:</font><%=datNewsTime%></td> 
  </tr> 

	<tr>
	<td bgcolor=#E8F1FF  align="center">
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回首页">&nbsp;&nbsp; 
	</td>
	</tr>


 </table>
		<%


End Function













Function del
dim id 
id=Request.QueryString("id")
%>
  <p style="margin-left:15px;">
  <b>删除</b></p>
	<%
	If Request("SubmitFlag") <> "" Then


			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&id&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs.delete
			end if
			rs.Close
			Set rs = Nothing

				response.Write "<meta http-equiv='refresh' content='1;URL=admin_bbs_Gather.asp'>"
%>
		<table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
		  <tr bgcolor=#f7f7f7 class=TBBG9> 
		    <td colspan="2">删除成功!<br/><a href='admin_bbs_Gather.asp'>返回列表管理</a></td>
 		 </tr>
		</table>

<%	else%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=del&id=<%=id%>">
<input type="hidden" name="SubmitFlag" value=yes>		
<table width="100%" border=0 align="center" cellpadding=5 cellspacing=1 bgcolor=#cccccc class=TBone>
  <tr bgcolor=#f7f7f7 class=TBBG9> 
    <td colspan="2">
      <strong><font color="#FF0000">确认信息： 真的要删除编号为<%=id%>列表吗？</font></strong><br><br>
      <input type=button value="不能删啊" onClick="javascript:history.go(-1);">
		<input type=submit name=删除 value="当然删除"></td>
  </tr>
</table>
</form>
<%
end if
End Function













Function savenew
dim itemid
itemid=Request("itemid")
if not isnumeric(itemid) then itemid=""


	If Request("SubmitFlag") = "savenew" Then

		startid=Request.Form("startid")
		lastid=Request.Form("lastid")

		if startid="" then startid=0
		if lastid="" then lastid=0



			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&Itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then
			rs("startid")=startid
			rs("lastid")=lastid
			rs.update()
			end if
			rs.Close
			Set rs = Nothing
		call BeginCollection
	Else
			savenew1
	End If


End Function





Function savenew1
dim itemid
itemid=TRim(Request("itemid"))
if not isnumeric(itemid) then itemid=""

			Dim sql,rs
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then

%>
<form name="pollform3sdx" method="post" action="admin_bbs_Gather.asp?Action=Begin&itemid=<%=itemid%>" >
  <input type="hidden" name="SubmitFlag" value="savenew">

  <p style="margin-left:15px;">
  <b>开始论坛帖子采集工作</b>
  <br/><a href='admin_bbs_Gather.asp'>返回论坛帖子采集</a></p>
  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">

	<tr>
	<td align="center">




		
  <table width="100%" border=0 align="center" cellpadding=5  cellspacing="1"  style="border-collapse: collapse" bordercolor="#6B8FC8"  class=TBone>
  <tr bgcolor=#E8F1FF class=TBBG9> 
    <td class="tar" width="25%">采集项目名称:</td>
    <td><%=rs("name")%>
    </td>
  </tr>


  <tr bgcolor=#f7f7f7 class=TBBG9  id="Pageinate2" > 
    <td class="tar" width="25%">远程列表起始页：</td>
    <td>
	开始页：<input name="startid" type="text"  value="<%=rs("startid")%>"  class=fminpt size="20" maxlength="255">&nbsp;-
   	结束页：<input name="lastid" type="text"  value="<%=rs("lastid")%>"  class=fminpt size="20" maxlength="255">&nbsp;
    	* 例如：1 - 9 或者 9 - 1
    </td>
  </tr>




 </table>

	<tr>
	<td bgcolor=#E8F1FF  align="center">
	<input type=submit name="B11" value="  开  始  采  集  ">　
	<input name="B12" type="button" class="Button" onClick="javascript:history.go(-1)" value="返回上一页">&nbsp;&nbsp; 
	</td>
	</tr>
	</td></tr>


</table>
</form>



<%
			end if
			rs.Close
			Set rs = Nothing



End Function













	'--数据采集
	Private Sub DataCollection()
%>
  <p style="margin-left:15px;">
  <b>论坛帖子采集项目&nbsp;&nbsp;-&nbsp;&nbsp;论坛帖子采集工作中......</b>
  <br/><a href='admin_bbs_Gather.asp'>返回论坛帖子采集</a></p>
  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">
	<tr>
	<td align="center">

<%
		ItemID = Request("ItemID")
		
		Dim ObjStream
		Dim strTemp, fromPath
		Dim RemoteListArray
		Dim d, RemoteUrl
		Dim totalnumber, CurrentPage
		
		fromPath = "tmpNewslist" & ItemID & ".dat"
		fromPath = Server.MapPath(fromPath)
		
		Set ObjStream = CreateObject("ADODB.Stream")
		ObjStream.Type = 1
		ObjStream.Mode = 3
		ObjStream.Open
		ObjStream.Position = 0
		ObjStream.LoadFromFile fromPath
		ObjStream.Position = 0
		ObjStream.Type = 2
		ObjStream.Charset = "GB2312"
		strTemp = ObjStream.ReadText()
		ObjStream.Close
		Set ObjStream = Nothing
		
		If Len(strTemp) < 10 Then
			Response.Write "<script language=javascript>" & vbCrLf
			Response.Write "alert('获取软件列表错误！');"
			Response.Write "history.go(-1);" & vbCrLf
			Response.Write "</script>" & vbCrLf
		End If

		RemoteListArray = Split(strTemp, vbNewLine)
		
		totalnumber = CLng(UBound(RemoteListArray) + 1)
		
		If Not IsEmpty(Request("page")) And Trim(Request("page")) <> "" Then
			CurrentPage = CLng(Request("page"))
			d = Request("d")
		Else
			CurrentPage = 0
			d = Timer()
		End If

			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then

			rs("ok")=CurrentPage
			rs.update
			end if
			rs.Close
			Set rs = Nothing


		Response.Write "<br><br>" & vbNewLine
		Response.Write "<table width='400' border='0' align='center' cellpadding='0' cellspacing='0'>" & vbNewLine
		Response.Write "  <tr>" & vbNewLine
		Response.Write "    <td height='50'>总共需要采集 <font color='blue'><b>" & totalnumber & "</b></font> 个页面，正在采集第 <font color='red'><b>" & CurrentPage & "</b></font>  个页面…… 成功采集：<font color='blue'><b>" & Session("SucceedCount") & "</b></font></td>" & vbNewLine
		Response.Write "  </tr>" & vbNewLine
		Response.Write "  <tr>" & vbNewLine
		Response.Write "    <td><table width='100%' border='0' cellpadding='1' cellspacing='1'>" & vbNewLine
		Response.Write "      <tr>" & vbNewLine
		Response.Write "        <td style=""border: 1px #384780 solid ;background-color: #FFFFFF;""><table width='" & Fix((CurrentPage / totalnumber) * 400) & "' height='12' border='0' cellpadding='0' cellspacing='0' bgcolor=#36D91A><tr><td></td></tr></table></td>" & vbNewLine
		Response.Write "      </tr>" & vbNewLine
		Response.Write "    </table></td>" & vbNewLine
		Response.Write "  </tr>" & vbNewLine
		Response.Write "  <tr>" & vbNewLine
		Response.Write "    <td align='center'>" & FormatNumber(CurrentPage / totalnumber * 100, 2, -1) & " %</td>" & vbNewLine
		Response.Write "  </tr>" & vbNewLine
		Response.Write "</table>" & vbNewLine
		Response.Write "<table width='400' border='0' align='center' cellpadding='0' cellspacing='0'>" & vbNewLine
		Response.Write "   <tr><td height='30' align='center'><input type='button' name='stop' value=' 立即停止采集 ' onclick=""window.location.href='" & ScriptName & "?action=yes&ChannelID=" & ChannelID & "&D=" & d & "&page=" & CurrentPage & "';"" class=button></td></tr>" & vbNewLine
		Response.Write "</table>" & vbNewLine
		Response.Flush
		
		If CurrentPage >= totalnumber Then
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,3
			if not (rs.bof and rs.eof) then

			rs("ok")=0
			rs.update

			end if
			rs.Close
			Set rs = Nothing


			DeleteFiles fromPath
			Response.Write "<meta http-equiv=""refresh"" content=""1;url='" & ScriptName & "?action=yes&ChannelID=" & ChannelID & "&page=" & CurrentPage + 1 & "&D=" & d & "'"">"
			Response.Flush
			Exit Sub
		End If
		
		RemoteUrl = RemoteListArray(CurrentPage)
		Call SaveNewsData(RemoteUrl)
		
		Response.Write "<script language='JavaScript'>" & vbNewLine
		Response.Write "function buildRefresh(){window.location.href='" & ScriptName & "?action=savenew&ChannelID=" & ChannelID & "&page=" & CurrentPage + 1 & "&ItemID=" & ItemID & "&D=" & d & "';}" & vbNewLine
		Response.Write "setTimeout('buildRefresh()',1000);" & vbNewLine
		Response.Write "</script>" & vbNewLine
		Response.Flush
%>
	</td>
	</tr>
	</td></tr>
</table>
<%
	End Sub




	'--开始采集
	Private Sub BeginCollection()
		Session("SucceedCount")=0
%>
  <p style="margin-left:15px;">
  <b>论坛帖子采集项目&nbsp;&nbsp;-&nbsp;&nbsp;论坛帖子采集工作中......</b>
  <br/><a href='admin_bbs_Gather.asp'>返回论坛帖子采集</a></p>
  <table width="100%" border="0" align="center" cellpadding="8" cellspacing="0">
	<tr>
	<td align="center">

<p align=center><div style="width:200px;height:30px;position:absolute;">
<table align=center border=0 cellpadding=0 cellspacing=1 bgcolor=#000000 width='200' height='30'>
<tr>
<td bgcolor=#0650D2>
<marquee align=middle behavior=alternate scrollamount=5 style="font-size:9pt">
<font color=#FFFFFF>...正在收集数据...请稍候...</font>
</marquee>
</td>
</tr>
</table>
</div>
</p>

	</td>
	</tr>
	</td></tr>
</table>
<%
		ItemID = Request("ItemID")
		If ItemID = 0 Then
			Response.Write "<script language=javascript>" & vbCrLf
			Response.Write "alert('错误的系统参数，请输入项目ID！');"
			Response.Write "history.go(-1);" & vbCrLf
			Response.Write "</script>" & vbCrLf
		End If
		


		Dim strRemoteLisCode, strRemoteListUrl
		Dim strFindListCode
		Dim i, n, strUrl
		Dim TempArray, RemoteListArray
		







			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,1
			if not (rs.bof and rs.eof) then
                        strReplace=rs("strReplace")
			ClassID=rs("ClassID")
			Encoding=rs("Encoding")
			ImgDown=rs("ImgDown")
			AllHits=rs("AllHits")
			IsNowTime=rs("IsNowTime")
			startid=rs("startid")
			lastid=rs("lastid")
			RemoteListUrl=rs("RemoteListUrl")
			PaginalList=rs("PaginalList")
			strFindListCode = Split(ReplaceTrim(rs("FindListCode")), "$$$")
			IsPagination=rs("IsPagination")

			end if
			rs.Close
			Set rs = Nothing




		strUrl=Trim(RemoteListUrl)


		'--获取远程列表网页源代码
		If CInt(IsPagination) = 0 Then
			HTTPHtmlCode = ReplaceTrim(GetRemoteData(strUrl, Encoding))
			If HTTPHtmlCode = "" Then
				Response.Write "<script language=javascript>" & vbCrLf
				Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
				Response.Write "history.go(-1);" & vbCrLf
				Response.Write "</script>" & vbCrLf

			End If

			'--获取远程列表代码
			strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
			strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
			'--获取列表URL
			strRemoteListUrl = FindMatch(strRemoteLisCode, strFindListCode(2), strFindListCode(3))

		Else

			

			If startid = lastid Then
				RemoteListUrl = Replace(Replace(PaginalList, "*", startid), "{$pageid}", startid, 1, -1, 1)


				If CheckHTTP(strUrl) Then
					HTTPHtmlCode = ReplaceTrim(GetRemoteData(strUrl, Encoding))
				Else
					HTTPHtmlCode = ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Encoding))
				End If


				If HTTPHtmlCode = "" Then
				Response.Write "<script language=javascript>" & vbCrLf
				Response.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
				Response.Write "history.go(-1);" & vbCrLf
				Response.Write "</script>" & vbCrLf
				End If


				'--获取远程列表代码
				strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
				strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
				'--获取列表URL
				strRemoteListUrl = FindMatch(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
			ElseIf startid < lastid Then
				For i = startid To lastid
					If Not Response.IsClientConnected Then Response.End
					strUrl = Replace(Replace(PaginalList, "*", i), "{$pageid}", i, 1, -1, 1)
					If i < 2 Then
						If CheckHTTP(strUrl) Then
							HTTPHtmlCode = ReplaceTrim(GetRemoteData(strUrl, Encoding))
						Else
							HTTPHtmlCode = ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Encoding))
						End If
					Else
						HTTPHtmlCode = ReplaceTrim(GetRemoteData(strUrl, Encoding))
					End If
					'--获取远程列表代码
					strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
					strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
					'--获取列表URL
					strRemoteListUrl = strRemoteListUrl & "|||" & FindMatch(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
				Next
			Else
				For i = lastid To startid
					If Not Response.IsClientConnected Then Response.End
					strUrl = Replace(Replace(PaginalList, "*", i), "{$pageid}", i, 1, -1, 1)
					If i < 2 Then
						If CheckHTTP(strUrl) Then
							HTTPHtmlCode = ReplaceTrim(GetRemoteData(strUrl, Encoding))
						Else
							HTTPHtmlCode = ReplaceTrim(GetRemoteData(Trim(RemoteListUrl), Encoding))
						End If
					Else
						HTTPHtmlCode = ReplaceTrim(GetRemoteData(strUrl, Encoding))
					End If
					'--获取远程列表代码
					strRemoteLisCode = CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
					strRemoteLisCode = ReplacedTrim(strRemoteLisCode)
					'--获取列表URL
					strRemoteListUrl = FindMatch(strRemoteLisCode, strFindListCode(2), strFindListCode(3)) & "|||" & strRemoteListUrl
				Next
			End If
		End If





		Dim TmpFilePath
		Dim oSteram
		Set oSteram = CreateObject("ADODB.Stream")
		TmpFilePath = "tmpNewslist" & ItemID & ".dat"
		TmpFilePath = Server.MapPath(TmpFilePath)
		


		'---- 设置为可读可写 ---- 内容为文本
		oSteram.Mode = 3
		oSteram.Type = 2
		oSteram.Open
		oSteram.Charset = "GB2312"
		
		RemoteListArray = Split(strRemoteListUrl, "|||")
		n = UBound(RemoteListArray)
                For i = 0 To n
		RemoteListArray(i) = ReplaceClass(RemoteListArray(i), strReplace)
                Next
		For i = 0 To n
			If Len(RemoteListArray(i)) > 5 Then

				If Not Response.IsClientConnected Then Response.End
				If i = n Then
					oSteram.WriteText FormatRemoteUrl(strUrl, RemoteListArray(i))
				Else
					oSteram.WriteText FormatRemoteUrl(strUrl, RemoteListArray(i)) & vbNewLine
				End If
			End If
		Next
		oSteram.SaveToFile TmpFilePath, 2

		oSteram.Close
		Set oSteram = Nothing
		



		Set Rs = CreateObject("ADODB.Recordset")
		SQL = "SELECT * FROM bbs_Item WHERE ID= " & ItemID
		Rs.Open SQL, Conn2, 1, 3
			Rs("lastime").Value = Now()
		Rs.Update
		Rs.Close
		Set Rs = Nothing
		




		Response.Write "<script language='JavaScript'>" & vbNewLine
		Response.Write "function reFresh(){window.location.href='?action=savenew&ItemID=" & ItemID & "';}" & vbNewLine
		Response.Write "setTimeout('reFresh()',1000);" & vbNewLine
		Response.Write "</script>" & vbNewLine
		
	End Sub






	'--保存数据库
	Public Sub SaveNewsData(URL)

		Dim i, FileNameArray
		Dim strEncoding, strFileExt
		Dim strRemoteLisCode, strRemoteListUrl
		Dim strFindListCode, strFindInfoCode
		Dim startcode, lastcode
		
		Dim strNewsTitle, NewsContent, TextContent
		Dim TempHtmlCode, TempContent, strTempContent, PaginationUrl
		Dim datNewsTime, strAuthor, strComeFrom
		Dim NewsBriefTopic, NewsRelated
		Dim NewsUploadFileList, NewsImageUrl
		Dim strParent, strChild, strParentName, strChildName

		Dim strAddedCode, strAddedlist, AddedlistArray
		Dim strFilePath
		
		ItemID = Request("ItemID")
		If ItemID = 0 Then Exit Sub
		NewsBriefTopic = 0




		




			set rs=server.CreateObject("adodb.recordset")
			sql="select * from bbs_Item where id="&itemid&""
			rs.open sql,conn2,1,1
			if not (rs.bof and rs.eof) then
                        strReplace=rs("strReplace")
			ClassID=rs("ClassID")
			strEncoding = Trim(rs("Encoding"))
			IsNextPage=rs("IsNextPage")

			ImgDown=rs("ImgDown")
			strFindInfoCode = Split(ReplaceTrim(rs("FindInfoCode")), "$$$")
			AllHits=rs("AllHits")
			IsNowTime=rs("IsNowTime")

			end if
			rs.Close
			Set rs = Nothing





		
		
		strRemoteListUrl = Trim(URL)
		
		If Len(strRemoteListUrl) < 10 Then Exit Sub
		
		HTTPHtmlCode = ReplaceTrim(GetRemoteData(strRemoteListUrl, strEncoding))
		If HTTPHtmlCode = "" Then
			%>获取远程信息出错！请确定你的远程连接代码输入无误。<br/><%
			Exit Sub

		End If
		
		'--获取论坛帖子标题
		strNewsTitle = CutFixed(HTTPHtmlCode, strFindInfoCode(0), strFindInfoCode(1))
				strNewsTitle = Trim(CheckHTML(strNewsTitle))
		If Len(strNewsTitle) = 0 Then
			%>获取标题代码出错！请确定你的代码输入正确。<br/><%
			Exit Sub
		End If
		
		'--获取论坛帖子内容
		NewsContent = CutFixed(HTTPHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
		If Len(NewsContent) = 0 Then
			%>获取论坛帖子内容代码出错！请确定你的代码输入正确。<br/><%
			Exit Sub
		End If

		
		'--获取论坛帖子作者
		If strFindInfoCode(4) <> "" And strFindInfoCode(4) <> "0" Then
			startcode = Replace(Replace(Replace(strFindInfoCode(4), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
			lastcode = Replace(Replace(Replace(strFindInfoCode(5), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild)
			strAuthor = CutFixed(HTTPHtmlCode, startcode, lastcode)
			strAuthor = CheckHTML(Trim(strAuthor))
		        strAuthor = CheckNostr(strAuthor)
		Else
			If strFindInfoCode(5) <> "" And strFindInfoCode(5) <> "0" Then
				strAuthor = Trim(strFindInfoCode(5))
		                strAuthor = CheckNostr(strAuthor)
			Else
				strAuthor = "佚名"
			End If
		End If
		If Len(strAuthor) = 0 Then strAuthor = "佚名"
		
		'--获取论坛帖子来源
		If strFindInfoCode(6) <> "" And strFindInfoCode(6) <> "0" Then
			startcode = Replace(Replace(Replace(Replace(strFindInfoCode(6), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
			lastcode = Replace(Replace(Replace(Replace(strFindInfoCode(7), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor)
			strComeFrom = CutFixed(HTTPHtmlCode, startcode, lastcode)
			strComeFrom = CheckHTML(Trim(strComeFrom))
		strComeFrom = CheckNostr(strComeFrom)
		Else
			If strFindInfoCode(7) <> "" And strFindInfoCode(7) <> "0" Then
				strComeFrom = Trim(strFindInfoCode(7))
		strComeFrom = CheckNostr(strComeFrom)
			Else
				strComeFrom = "本站整理"
			End If
		End If
		If Len(strComeFrom) = 0 Then strComeFrom = "本站整理"		
		If CInt(IsNowTime) = 0 Then
			'--获取更新时间
			If strFindInfoCode(8) <> "" And strFindInfoCode(8) <> "0" Then
				startcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(8), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
				lastcode = Replace(Replace(Replace(Replace(Replace(strFindInfoCode(9), "{@NewsTitle}", strNewsTitle), "{@ParentName}", strParent), "{@ChildName}", strChild), "{@NewsAuthor}", strAuthor), "{@NewsComeFrom}", strComeFrom)
				datNewsTime = CutFixed(HTTPHtmlCode, startcode, lastcode)
				datNewsTime = CheckHTML(datNewsTime)
				datNewsTime = CheckNostr(datNewsTime)
				datNewsTime = Formatime(Trim(datNewsTime))
			Else
				datNewsTime = Now
			End If
		Else
			datNewsTime = Now
		End If
		





		'--------------获取分页内容部分开始-----------------
				Dim n, strTempArray
				If CInt(IsNextPage) > 0 And strFindInfoCode(10) <> "" And strFindInfoCode(10) <> "0" And strFindInfoCode(11) <> "" And strFindInfoCode(11) <> "0" Then
					'-- 分页方法

					If strFindInfoCode(12) <> "" And strFindInfoCode(12) <> "0" And strFindInfoCode(13) <> "" And strFindInfoCode(13) <> "0" Then
						'--从内容中读取分页获取列表
						strAddedCode = CutFixate(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
						strAddedCode = ReplaceTrim(strAddedCode)
						If Len(strAddedCode) = 0 Then
							'--从整个HTML代码中获取列表
							strAddedCode = CutFixate(HTTPHtmlCode, strFindInfoCode(10), strFindInfoCode(11))
							strAddedCode = ReplaceTrim(strAddedCode)
						End If
						
						strAddedCode = ReplaceTrim(strAddedCode)
						'--如果可以获取分页列表,开始获取分页URL
						If Len(strAddedCode) > 0 Then
							strAddedlist = FindMatch(strAddedCode, strFindInfoCode(12), strFindInfoCode(13))

							'--判断是否获取到URL
							If Len(strAddedlist) > 0 Then
								strTempContent = ""
								'--把所有URL分割成数组
								AddedlistArray = Split(strAddedlist, "|||")
								For i = 0 To UBound(AddedlistArray)
									'--格式化URL成绝对路径
									PaginationUrl = FormatRemoteUrl(strRemoteListUrl, AddedlistArray(i))
									'--只有URL和当前URL不一样的时候才采集分页信息
									If Len(PaginationUrl) > 8 And LCase(PaginationUrl) <> LCase(strRemoteListUrl) Then
										TempHtmlCode = ReplaceTrim(GetRemoteData(PaginationUrl, strEncoding))
										If Len(TempHtmlCode) > 10 Then
											TempContent = CutFixed(TempHtmlCode, strFindInfoCode(2), strFindInfoCode(3))
											If Len(TempContent) > 0 Then
												'--将获取到分页内容写入到一个临时变量
												strTempContent = strTempContent &  TempContent
											End If
										End If
									End If
								Next
								NewsContent = NewsContent & strTempContent
								NewsContent = CheckMatch(NewsContent, strFindInfoCode(10), strFindInfoCode(11))
							End If
						End If
					End If
				End If


		'-----------------获取分页内容结束--------------------
		'------------ 内容替换操作 -----------------------	

				TextContent = Html2Ubb(NewsContent, RemoveCode)
				If strFindInfoCode(14) <> "" And strFindInfoCode(14) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(14), "")
				End If
				If strFindInfoCode(15) <> "" And strFindInfoCode(15) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(15), "")
				End If
				If strFindInfoCode(16) <> "" And strFindInfoCode(16) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(16), "")
				End If
				If strFindInfoCode(17) <> "" And strFindInfoCode(17) <> "0" Then
					TextContent = Replace(TextContent, strFindInfoCode(17), "")
				End If
				If strFindInfoCode(18) <> "" And strFindInfoCode(18) <> "0" Then
					If strFindInfoCode(19) <> "" And strFindInfoCode(19) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(22), strFindInfoCode(19))
					End If
				End If
				If strFindInfoCode(20) <> "" And strFindInfoCode(20) <> "0" Then
					If strFindInfoCode(21) <> "" And strFindInfoCode(21) <> "0" Then
						TextContent = CheckMatch(TextContent, strFindInfoCode(20), strFindInfoCode(21))
					End If
				End If
				TextContent = FormatContentUrl(TextContent, strRemoteListUrl)


				'--论坛帖子内容替换操作
				If Len(strReplace) > 0 Then
					TextContent = ReplaceClass(TextContent, strReplace)
					strComeFrom = ReplaceClass(strComeFrom, strReplace)
				End If

				if instr(TextContent,".html"">上一页</a>&nbsp;&nbsp;<a href=""http://wap.qt3g.com/")>0 then TextContent=left(TextContent,instrREV(TextContent,"</div>",instr(TextContent,".html"">上一页</a>&nbsp;&nbsp;<a href=""http://wap.qt3g.com/"))-1)


		'---------- 内容字符替换完成 ---------------------------------
		

		'--重新格式化论坛帖子标题

		If CLng(AllHits) = 999 Then AllHits = GetRndHits
		'--论坛帖子关键字
		NewsRelated = strNewsTitle
		NewsRelated = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(NewsRelated, "|", ""), "[", ""), "]", ""), "<", ""), ">", ""), "'", ""), """", ""), "$", "")
		NewsRelated = Left(NewsRelated, 4) & "|" & Right(NewsRelated, 4)
		
		Response.Flush
		Response.Write "<p></p><br><table border=0 align=center cellpadding=3 cellspacing=1 class=TableBorder>"
		Response.Write " <tr>"
		Response.Write "   <th><span id=txt1>正在采集，请稍候....</span></th>"
		Response.Write " </tr>"
		Response.Write " <tr>"
		Response.Write "   <td class=TableRow1><strong><font color=blue>" & sModuleName & "标题：</font></strong>"
		Response.Write "<font color=red>" & strNewsTitle & "</font> &nbsp;&nbsp;<br>"
		Response.Write "<strong><font color=blue>" & sModuleName & "作者：</font></strong>"
		Response.Write strAuthor
		Response.Write "<br><strong><font color=blue>" & sModuleName & "来源：</font></strong>"
		Response.Write strComeFrom
		If CInt(AutoClass) > 0 Then
			Response.Write "<br><strong><font color=blue>" & sModuleName & "类别：</font></strong>"
			Response.Write strParentName & " / " & strChildName
		End If
		Response.Write "<br><strong><font color=blue>采集时间：</font></strong>"
		Response.Write Now()
		Response.Write "<br><strong><font color=blue>目标地址：</font></strong>"
		Response.Write "<a href='" & URL & "' target=_blank>" & URL & "</a>"
		Response.Write "<div><li><span id=txt2 name=txt2 style=""font-size:9pt;color:red;"">正在采集，请稍候....</span></div>"
		Response.Write "<br><div align=center>"
		Response.Write "[<a href='?ChannelID=" & ChannelID & "'><font color=blue>停止采集</font></a>]</div>"
		Response.Write "   </td>"
		Response.Write " </tr>"
		Response.Write "</table>"
		Response.Flush
		
		'---------- 格式化内容图片URL 供下载使用----------------------
		TextContent = FormatContentUrl(TextContent, strRemoteListUrl)
		'--如果内容中有图片就保存
		If PictureExist Then

			NewsBriefTopic = 1
			If CInt(ImgDown) > 0 Then


			strFilePath="upload/" & year(now()) & "/" & month(now()) & "/" & day(now()) & "/"

			CreateFolder strFilePath


			Path = server.mappath(Request.ServerVariables("SCRIPT_NAME"))
			Path=left(Path,instrrev(Path,"\" ) - 1 )
			strFilePath=path & "/../" & strFilePath


				MaxSize = 5000
				sAllowExtName = "gif|jpg|png|bmp"
				TextContent = RemoteToLocal(TextContent, strFilePath)
				NewsUploadFileList = PathFileName



				FileNameArray = Split(NewsUploadFileList, "|")
				If UBound(FileNameArray) < 3 Then
					NewsBriefTopic = 1
				Else
					NewsBriefTopic = 2
				End If
				For i = 0 To UBound(FileNameArray)
					If Len(FileNameArray(i)) > 0 Then
						strFileExt = LCase(GetFileExtName(FileNameArray(i)))
						If strFileExt = "gif" Then
							NewsImageUrl = FileNameArray(i)
							Exit For
						End If
						If strFileExt = "jpg" Then
							NewsImageUrl = FileNameArray(i)
							Exit For
						End If
						If strFileExt = "png" Then
							NewsImageUrl = FileNameArray(i)
							Exit For
						End If
						If strFileExt = "bmp" Then
							NewsImageUrl = FileNameArray(i)
							Exit For
						End If
					End If
				Next
			End If
		Else
			NewsBriefTopic = 0
		End If
		'------------图片下载完成------------------
		
		Dim IsUpdates, blnUpdates,bbsa,bbsb
		Dim strInfo, strMessage, namenid
		'--开始入库
%>
<!--#include file="kttt.asp"-->
<%
		Set Rs = CreateObject("ADODB.Recordset")
                Randomize 
		SQL = "SELECT top 1 * FROM qingtian_user where id="&int(rnd()*(bbsb-bbsa)+bbsa)
		Rs.Open SQL, Conn, 1, 1
		If not(Rs.BOF And Rs.EOF) Then
                namenid=rs("id")
                end if
		Rs.close
		Set rs = Nothing
                if namenid="" then namenid=bbsa

		Set Rs = CreateObject("ADODB.Recordset")
		SQL = "SELECT * FROM qingtian_bbs_forum WHERE name='" & strNewsTitle & "'"
		Rs.Open SQL, Conn, 1, 3
		If Rs.BOF And Rs.EOF Then
			IsUpdates = True

		Else
			IsUpdates = False
		End If

		If IsUpdates Then

				TextContent=toHTML(TextContent)
				if instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com")>0 then
					if instrREV(TextContent,"[b][url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com")) >0 then
						TextContent=left(TextContent,instrREV(TextContent,"[b][url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com"))-1)
					elseif instrREV(TextContent,"[url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com")) >0 then
						TextContent=left(TextContent,instrREV(TextContent,"[url=",instr(TextContent,".html]上一页[/url]&nbsp;&nbsp;[url=http://wap.qt3g.com"))-1)
					end if
				end if
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(13)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(10)&Chr(13)&Chr(13), vbNullString)
 TextContent=Replace(left(TextContent,5000), Chr(32)&Chr(13)&Chr(13), vbNullString)
				Rs.AddNew
				Rs("listid") = ClassID
				Rs("name") = left(strNewsTitle,30)
				Rs("content") = TextContent
				Rs("nid") = namenid
				Rs.Update
			strMessage = "采集成功"
			strInfo = "恭喜您！采集成功"
			Session("SucceedCount") = Session("SucceedCount") + 1
		Else
			strMessage = "采集失败"
			strInfo = "目标论坛帖子已存在，不予采集"
		End If
		Rs.Close
		Set Rs = Nothing
		
		If IsUpdates Then

		Set Rs = Server.CreateObject("Adodb.Recordset")
		Sql = "select [tid] FROM qingtian_bbs  where [id]="&ClassID&""
		Rs.Open Sql,conn,1,3
		if not (rs.eof and rs.bof) then
		rs("tid")=rs("tid")+1
		rs.update
		end if
		Rs.close
		Set rs = Nothing
		End If



		'-- 返回提示信息
		Response.Write "<script>"
		Response.Write "txt1.innerHTML='" & strMessage & "';"
		Response.Write "txt2.innerHTML='" & strInfo & "';"
		Response.Write "</script>" & vbCrLf
		Response.Flush
	End Sub
%>
<div align="center" class="TBBG91"><a href='/index.asp?sid=<%=sidd%>'>返回网站首页</a></div>
